HaRe 0.8.2.3 → 0.8.3.0

raw patch · 108 files changed

+10991/−9973 lines, 108 filesdep +gitrevdep +optparse-applicativedep +optparse-simpledep ~basedep ~ghc-exactprintdep ~ghc-modPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: gitrev, optparse-applicative, optparse-simple

Dependency ranges changed: base, ghc-exactprint, ghc-mod

API changes (from Hackage documentation)

- Language.Haskell.Refact.API: allNames :: (Data t) => t -> [Located Name]

- Language.Haskell.Refact.API: class (Data t, Data name) => HsValBinds t name | t -> name

- Language.Haskell.Refact.API: definedPNs :: LHsBind Name -> [Name]

- Language.Haskell.Refact.API: defines :: Name -> LHsBind Name -> Bool

- Language.Haskell.Refact.API: definesP :: PName -> HsDeclP -> Bool

- Language.Haskell.Refact.API: definesTypeSig :: Name -> LSig Name -> Bool

- Language.Haskell.Refact.API: definingDeclsNames :: [Name] -> [LHsBind Name] -> Bool -> Bool -> [LHsBind Name]

- Language.Haskell.Refact.API: definingDeclsNames' :: (Data t) => [Name] -> t -> [LHsBind Name]

- Language.Haskell.Refact.API: definingSigsNames :: (Data t) => [Name] -> t -> [LSig Name]

- Language.Haskell.Refact.API: expToName :: LHsExpr Name -> Name

- Language.Haskell.Refact.API: findAllNameOccurences :: (Data t) => Name -> t -> [(Located Name)]

- Language.Haskell.Refact.API: findPN :: (Data t) => Name -> t -> Bool

- Language.Haskell.Refact.API: findPNT :: (Data t) => Located Name -> t -> Bool

- Language.Haskell.Refact.API: findPNs :: (Data t) => [Name] -> t -> Bool

- Language.Haskell.Refact.API: getDeclaredTypes :: LTyClDecl Name -> [Name]

- Language.Haskell.Refact.API: getDeclaredVars :: [LHsBind Name] -> [Name]

- Language.Haskell.Refact.API: getFreeVars :: [LHsBind Name] -> [Name]

- Language.Haskell.Refact.API: getFvs :: [LHsBind Name] -> [([Name], NameSet)]

- Language.Haskell.Refact.API: getParsedForRenamedLPat :: ParsedSource -> LPat Name -> LPat RdrName

- Language.Haskell.Refact.API: getParsedForRenamedLocated :: (Typeable b) => Located a -> RefactGhc (Located b)

- Language.Haskell.Refact.API: getParsedForRenamedName :: ParsedSource -> Located Name -> Located RdrName

- Language.Haskell.Refact.API: ghcToPN :: RdrName -> PName

- Language.Haskell.Refact.API: hsBinds :: (HsValBinds t name) => t -> [LHsBind name]

- Language.Haskell.Refact.API: hsFDNamesFromInside :: (Data t) => t -> RefactGhc ([String], [String])

- Language.Haskell.Refact.API: hsFDsFromInside :: (Data t) => t -> RefactGhc ([Name], [Name])

- Language.Haskell.Refact.API: hsFreeAndDeclaredGhc :: (Data t) => t -> RefactGhc (FreeNames, DeclaredNames)

- Language.Haskell.Refact.API: hsFreeAndDeclaredPNsOld :: (Data t) => t -> ([Name], [Name])

- Language.Haskell.Refact.API: hsPNs :: (Data t) => t -> [PName]

- Language.Haskell.Refact.API: hsTyDecls :: HsValBinds t name => t -> [[LTyClDecl name]]

- Language.Haskell.Refact.API: hsValBinds :: HsValBinds t name => t -> HsValBinds name

- Language.Haskell.Refact.API: hsVisibleDs :: (FindEntity e, Outputable e, Data t, HsValBinds t Name) => e -> t -> RefactGhc DeclaredNames

- Language.Haskell.Refact.API: hsVisibleNames :: (FindEntity t1, HsValBinds t2 Name, Outputable t1) => t1 -> t2 -> RefactGhc [String]

- Language.Haskell.Refact.API: hsVisiblePNs :: (FindEntity e, HsValBinds t Name, Outputable e) => e -> t -> RefactGhc [Name]

- Language.Haskell.Refact.API: hsVisiblePNsRdr :: (FindEntity e, Data t, Outputable e) => NameMap -> e -> t -> RefactGhc [Name]

- Language.Haskell.Refact.API: isDeclaredIn :: (HsValBinds t Name) => Name -> t -> Bool

- Language.Haskell.Refact.API: isUsedInRhs :: (Data t) => (Located Name) -> t -> Bool

- Language.Haskell.Refact.API: lghcToPN :: Located RdrName -> PName

- Language.Haskell.Refact.API: locToName :: (Data t) => SimpPos -> t -> Maybe (Located Name)

- Language.Haskell.Refact.API: onelayerStaged :: Stage -> r -> GenericQ r -> GenericQ [r]

- Language.Haskell.Refact.API: patToPNT :: LPat Name -> Maybe Name

- Language.Haskell.Refact.API: sameBind :: LHsBind Name -> LHsBind Name -> Bool

- Language.Haskell.Refact.API: stripLeadingSpaces :: [String] -> [String]

- Language.Haskell.Refact.API: usedByRhs :: UsedByRhs t => t -> [Name] -> Bool

- Language.Haskell.Refact.Utils.Binds: class (Data t, Data name) => HsValBinds t name | t -> name

- Language.Haskell.Refact.Utils.Binds: getValBindSigs :: HsValBinds RdrName -> [LSig RdrName]

- Language.Haskell.Refact.Utils.Binds: hsBinds :: (HsValBinds t name) => t -> [LHsBind name]

- Language.Haskell.Refact.Utils.Binds: hsTyDecls :: HsValBinds t name => t -> [[LTyClDecl name]]

- Language.Haskell.Refact.Utils.Binds: hsValBinds :: HsValBinds t name => t -> HsValBinds name

- Language.Haskell.Refact.Utils.Binds: instance (Outputable.OutputableBndr name, PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsBinds.HsBind name) name

- Language.Haskell.Refact.Utils.Binds: instance (Outputable.OutputableBndr name, PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsPat.LPat name) name

- Language.Haskell.Refact.Utils.Binds: instance (Outputable.OutputableBndr name, PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds [HsPat.LPat name] name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsBinds.HsLocalBinds name) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsBinds.HsValBinds name) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsDecls.HsGroup name) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsDecls.LTyFamInstEqn name) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsExpr.GRHSs name (HsExpr.LHsExpr name)) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsExpr.LMatch name (HsExpr.LHsExpr name)) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsExpr.Match name (HsExpr.LHsExpr name)) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds (HsExpr.MatchGroup name (HsExpr.LHsExpr name)) name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds [HsBinds.LHsBind name] name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds [HsDecls.LTyFamInstEqn name] name

- Language.Haskell.Refact.Utils.Binds: instance (PlaceHolder.DataId name, Data.Data.Data name) => Language.Haskell.Refact.Utils.Binds.HsValBinds [HsExpr.LMatch name (HsExpr.LHsExpr name)] name

- Language.Haskell.Refact.Utils.Binds: instance Language.Haskell.Refact.Utils.Binds.HsValBinds GHC.ParsedSource RdrName.RdrName

- Language.Haskell.Refact.Utils.Binds: instance Language.Haskell.Refact.Utils.Binds.HsValBinds GHC.RenamedSource Name.Name

- Language.Haskell.Refact.Utils.Binds: instance Language.Haskell.Refact.Utils.Binds.HsValBinds Name.Name Name.Name

- Language.Haskell.Refact.Utils.GhcUtils: onelayerStaged :: Stage -> r -> GenericQ r -> GenericQ [r]

- Language.Haskell.Refact.Utils.TypeUtils: defines :: Name -> LHsBind Name -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: definesP :: PName -> HsDeclP -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: definesTypeSig :: Name -> LSig Name -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: expToName :: LHsExpr Name -> Name

- Language.Haskell.Refact.Utils.TypeUtils: findAllNameOccurences :: (Data t) => Name -> t -> [(Located Name)]

- Language.Haskell.Refact.Utils.TypeUtils: findEntity :: (FindEntity a, Data b) => a -> b -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: findNameInRdr :: (Data t) => NameMap -> Name -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: findNamesRdr :: (Data t) => NameMap -> [Name] -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: findPN :: (Data t) => Name -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: findPNT :: (Data t) => Located Name -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: findPNs :: (Data t) => [Name] -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: getParsedForRenamedLPat :: ParsedSource -> LPat Name -> LPat RdrName

- Language.Haskell.Refact.Utils.TypeUtils: getParsedForRenamedLocated :: (Typeable b) => Located a -> RefactGhc (Located b)

- Language.Haskell.Refact.Utils.TypeUtils: getParsedForRenamedName :: ParsedSource -> Located Name -> Located RdrName

- Language.Haskell.Refact.Utils.TypeUtils: ghcToPN :: RdrName -> PName

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsBinds.HsBind Name.Name)

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsBinds.HsValBinds Name.Name)

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsBinds.LHsBinds Name.Name)

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsExpr.HsExpr Name.Name)

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsExpr.Match Name.Name (HsExpr.LHsExpr Name.Name))

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsExpr.Stmt Name.Name (HsExpr.LHsExpr Name.Name))

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs GHC.RenamedSource

- Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs [HsBinds.LHsBind Name.Name]

- Language.Haskell.Refact.Utils.TypeUtils: isUsedInRhs :: (Data t) => (Located Name) -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: lghcToPN :: Located RdrName -> PName

- Language.Haskell.Refact.Utils.TypeUtils: locToName :: (Data t) => SimpPos -> t -> Maybe (Located Name)

- Language.Haskell.Refact.Utils.TypeUtils: patToPNT :: LPat Name -> Maybe Name

- Language.Haskell.Refact.Utils.TypeUtils: sameBind :: LHsBind Name -> LHsBind Name -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: stripLeadingSpaces :: [String] -> [String]

- Language.Haskell.Refact.Utils.TypeUtils: usedByRhs :: UsedByRhs t => t -> [Name] -> Bool

- Language.Haskell.Refact.Utils.Types: RSAlreadyLoaded :: RefacSource

- Language.Haskell.Refact.Utils.Types: RSFile :: FilePath -> RefacSource

- Language.Haskell.Refact.Utils.Types: RSMod :: ModSummary -> RefacSource

- Language.Haskell.Refact.Utils.Types: data RefacSource

- Language.Haskell.Refact.Utils.Variables: allNames :: (Data t) => t -> [Located Name]

- Language.Haskell.Refact.Utils.Variables: definedPNs :: LHsBind Name -> [Name]

- Language.Haskell.Refact.Utils.Variables: defines :: Name -> LHsBind Name -> Bool

- Language.Haskell.Refact.Utils.Variables: definesP :: PName -> HsDeclP -> Bool

- Language.Haskell.Refact.Utils.Variables: definesTypeSig :: Name -> LSig Name -> Bool

- Language.Haskell.Refact.Utils.Variables: definingDeclsNames :: [Name] -> [LHsBind Name] -> Bool -> Bool -> [LHsBind Name]

- Language.Haskell.Refact.Utils.Variables: definingDeclsNames' :: (Data t) => [Name] -> t -> [LHsBind Name]

- Language.Haskell.Refact.Utils.Variables: definingSigsNames :: (Data t) => [Name] -> t -> [LSig Name]

- Language.Haskell.Refact.Utils.Variables: getDeclaredTypes :: LTyClDecl Name -> [Name]

- Language.Haskell.Refact.Utils.Variables: getDeclaredVars :: [LHsBind Name] -> [Name]

- Language.Haskell.Refact.Utils.Variables: getFreeVars :: [LHsBind Name] -> [Name]

- Language.Haskell.Refact.Utils.Variables: getFvs :: [LHsBind Name] -> [([Name], NameSet)]

- Language.Haskell.Refact.Utils.Variables: hsFDNamesFromInside :: (Data t) => t -> RefactGhc ([String], [String])

- Language.Haskell.Refact.Utils.Variables: hsFDsFromInside :: (Data t) => t -> RefactGhc ([Name], [Name])

- Language.Haskell.Refact.Utils.Variables: hsFreeAndDeclaredGhc :: (Data t) => t -> RefactGhc (FreeNames, DeclaredNames)

- Language.Haskell.Refact.Utils.Variables: hsFreeAndDeclaredPNsOld :: (Data t) => t -> ([Name], [Name])

- Language.Haskell.Refact.Utils.Variables: hsNamess :: (Data t) => t -> [Name]

- Language.Haskell.Refact.Utils.Variables: hsPNs :: (Data t) => t -> [PName]

- Language.Haskell.Refact.Utils.Variables: hsVisibleDs :: (FindEntity e, Outputable e, Data t, HsValBinds t Name) => e -> t -> RefactGhc DeclaredNames

- Language.Haskell.Refact.Utils.Variables: hsVisibleNames :: (FindEntity t1, HsValBinds t2 Name, Outputable t1) => t1 -> t2 -> RefactGhc [String]

- Language.Haskell.Refact.Utils.Variables: hsVisiblePNs :: (FindEntity e, HsValBinds t Name, Outputable e) => e -> t -> RefactGhc [Name]

- Language.Haskell.Refact.Utils.Variables: hsVisiblePNsRdr :: (FindEntity e, Data t, Outputable e) => NameMap -> e -> t -> RefactGhc [Name]

- Language.Haskell.Refact.Utils.Variables: isDeclaredIn :: (HsValBinds t Name) => Name -> t -> Bool

- Language.Haskell.Refact.Utils.Variables: locToName :: (Data t) => SimpPos -> t -> Maybe (Located Name)

- Language.Haskell.Refact.Utils.Variables: rdrName2Name' :: Located RdrName -> RefactGhc Name

+ Language.Haskell.Refact.API: NoQualify :: HowToQual

+ Language.Haskell.Refact.API: PreserveQualify :: HowToQual

+ Language.Haskell.Refact.API: Qualify :: HowToQual

+ Language.Haskell.Refact.API: RSTarget :: TargetModule -> RefacSource

+ Language.Haskell.Refact.API: addParamsToSigs :: [Name] -> LSig RdrName -> RefactGhc (LSig RdrName)

+ Language.Haskell.Refact.API: balanceAllComments :: Data a => Located a -> Transform (Located a)

+ Language.Haskell.Refact.API: clearPriorComments :: (Data a) => Located a -> Transform ()

+ Language.Haskell.Refact.API: copyAnn :: (Data old, Data new) => Located old -> Located new -> Anns -> Anns

+ Language.Haskell.Refact.API: data HowToQual

+ Language.Haskell.Refact.API: definesSigDRdr :: NameMap -> Name -> LHsDecl RdrName -> Bool

+ Language.Haskell.Refact.API: definesTypeSigRdr :: NameMap -> Name -> Sig RdrName -> Bool

+ Language.Haskell.Refact.API: findLRdrName :: (Data t) => NameMap -> Name -> t -> Bool

+ Language.Haskell.Refact.API: getDeclaredVarsRdr :: NameMap -> [LHsDecl RdrName] -> [Name]

+ Language.Haskell.Refact.API: hsFDNamesFromInsideRdrPure :: (Data t) => NameMap -> t -> ([String], [String])

+ Language.Haskell.Refact.API: hsNamessRdr :: (Data t) => t -> [Located RdrName]

+ Language.Haskell.Refact.API: hsQualifier :: Name -> RefactGhc [ModuleName]

+ Language.Haskell.Refact.API: hsTypeVbls :: (Data t) => t -> ([RdrName], [RdrName])

+ Language.Haskell.Refact.API: hsVisibleDsRdr :: (Data t) => NameMap -> Name -> t -> RefactGhc DeclaredNames

+ Language.Haskell.Refact.API: locToNameRdrPure :: (Data t) => NameMap -> SimpPos -> t -> Maybe Name

+ Language.Haskell.Refact.API: logExactprint :: (Annotate a) => String -> Located a -> RefactGhc ()

+ Language.Haskell.Refact.API: logParsedSource :: String -> RefactGhc ()

+ Language.Haskell.Refact.API: mkQualifiedRdrName :: ModuleName -> String -> RdrName

+ Language.Haskell.Refact.API: parseDeclWithAnns :: String -> RefactGhc (LHsDecl RdrName)

+ Language.Haskell.Refact.API: registerRdrName :: Located RdrName -> RefactGhc ()

+ Language.Haskell.Refact.API: setAnnKeywordDP :: (Data a) => Located a -> KeywordId -> DeltaPos -> Transform ()

+ Language.Haskell.Refact.API: stripCallStack :: String -> String

+ Language.Haskell.Refact.HaRe: [optEncoding] :: Options -> String

+ Language.Haskell.Refact.HaRe: addOneParameter :: RefactSettings -> Options -> FilePath -> String -> SimpPos -> IO [FilePath]

+ Language.Haskell.Refact.HaRe: compAddOneParameter :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]

+ Language.Haskell.Refact.HaRe: compRmOneParameter :: FilePath -> SimpPos -> RefactGhc [ApplyRefacResult]

+ Language.Haskell.Refact.HaRe: rmOneParameter :: RefactSettings -> Options -> FilePath -> SimpPos -> IO [FilePath]

+ Language.Haskell.Refact.Refactoring.AddRmParam: compAddOneParameter :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]

+ Language.Haskell.Refact.Refactoring.AddRmParam: compRmOneParameter :: FilePath -> SimpPos -> RefactGhc [ApplyRefacResult]

+ Language.Haskell.Refact.Refactoring.AddRmParam: rmOneParameter :: RefactSettings -> Options -> FilePath -> SimpPos -> IO [FilePath]

+ Language.Haskell.Refact.Utils.ExactPrint: balanceAllComments :: Data a => Located a -> Transform (Located a)

+ Language.Haskell.Refact.Utils.ExactPrint: clearPriorComments :: (Data a) => Located a -> Transform ()

+ Language.Haskell.Refact.Utils.ExactPrint: setAnnKeywordDP :: (Data a) => Located a -> KeywordId -> DeltaPos -> Transform ()

+ Language.Haskell.Refact.Utils.Monad: RSAlreadyLoaded :: RefacSource

+ Language.Haskell.Refact.Utils.Monad: RSFile :: FilePath -> RefacSource

+ Language.Haskell.Refact.Utils.Monad: RSMod :: ModSummary -> RefacSource

+ Language.Haskell.Refact.Utils.Monad: RSTarget :: TargetModule -> RefacSource

+ Language.Haskell.Refact.Utils.Monad: data RefacSource

+ Language.Haskell.Refact.Utils.MonadFunctions: addToNameMap :: SrcSpan -> Name -> RefactGhc ()

+ Language.Haskell.Refact.Utils.MonadFunctions: logExactprint :: (Annotate a) => String -> Located a -> RefactGhc ()

+ Language.Haskell.Refact.Utils.TypeUtils: NoQualify :: HowToQual

+ Language.Haskell.Refact.Utils.TypeUtils: PreserveQualify :: HowToQual

+ Language.Haskell.Refact.Utils.TypeUtils: Qualify :: HowToQual

+ Language.Haskell.Refact.Utils.TypeUtils: addParamsToSigs :: [Name] -> LSig RdrName -> RefactGhc (LSig RdrName)

+ Language.Haskell.Refact.Utils.TypeUtils: data HowToQual

+ Language.Haskell.Refact.Utils.TypeUtils: hsQualifier :: Name -> RefactGhc [ModuleName]

+ Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (HsImpExp.IE RdrName.RdrName)

+ Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs [HsImpExp.LIE RdrName.RdrName]

+ Language.Haskell.Refact.Utils.TypeUtils: instance Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs a => Language.Haskell.Refact.Utils.TypeUtils.UsedByRhs (GHC.Base.Maybe a)

+ Language.Haskell.Refact.Utils.TypeUtils: instance Outputable.Outputable Language.Haskell.Refact.Utils.TypeUtils.HowToQual

+ Language.Haskell.Refact.Utils.TypeUtils: mkQualifiedRdrName :: ModuleName -> String -> RdrName

+ Language.Haskell.Refact.Utils.TypeUtils: registerRdrName :: Located RdrName -> RefactGhc ()

+ Language.Haskell.Refact.Utils.Utils: stripCallStack :: String -> String

+ Language.Haskell.Refact.Utils.Variables: findLRdrName :: (Data t) => NameMap -> Name -> t -> Bool

+ Language.Haskell.Refact.Utils.Variables: findNameInRdr :: (Data t) => NameMap -> Name -> t -> Bool

+ Language.Haskell.Refact.Utils.Variables: findNamesRdr :: (Data t) => NameMap -> [Name] -> t -> Bool

+ Language.Haskell.Refact.Utils.Variables: getDeclaredVarsRdr :: NameMap -> [LHsDecl RdrName] -> [Name]

+ Language.Haskell.Refact.Utils.Variables: hsFDNamesFromInsideRdrPure :: (Data t) => NameMap -> t -> ([String], [String])

+ Language.Haskell.Refact.Utils.Variables: hsTypeVbls :: (Data t) => t -> ([RdrName], [RdrName])

+ Language.Haskell.Refact.Utils.Variables: locToNameRdr :: (Data t) => SimpPos -> t -> RefactGhc (Maybe Name)

+ Language.Haskell.Refact.Utils.Variables: locToNameRdrPure :: (Data t) => NameMap -> SimpPos -> t -> Maybe Name

- Language.Haskell.Refact.API: addItemsToExport :: ParsedSource -> Maybe PName -> Bool -> Either [String] [LIE RdrName] -> RefactGhc ParsedSource

+ Language.Haskell.Refact.API: addItemsToExport :: ParsedSource -> Maybe Name -> Bool -> Either [RdrName] [LIE RdrName] -> RefactGhc ParsedSource

- Language.Haskell.Refact.API: addItemsToImport :: ModuleName -> ParsedSource -> [RdrName] -> RefactGhc ParsedSource

+ Language.Haskell.Refact.API: addItemsToImport :: ModuleName -> Maybe Name -> Either [RdrName] [LIE RdrName] -> ParsedSource -> RefactGhc ParsedSource

- Language.Haskell.Refact.API: causeNameClashInExports :: Name -> Name -> ModuleName -> RenamedSource -> Bool

+ Language.Haskell.Refact.API: causeNameClashInExports :: NameMap -> Name -> Name -> ModuleName -> ParsedSource -> Bool

- Language.Haskell.Refact.API: definingTyClDeclsNames :: (Data t) => [Name] -> t -> [LTyClDecl Name]

+ Language.Haskell.Refact.API: definingTyClDeclsNames :: (Data t) => NameMap -> [Name] -> t -> [LTyClDecl RdrName]

- Language.Haskell.Refact.API: hsFDsFromInsideRdr :: (Data t) => NameMap -> t -> RefactGhc (FreeNames, DeclaredNames)

+ Language.Haskell.Refact.API: hsFDsFromInsideRdr :: (Data t) => NameMap -> t -> (FreeNames, DeclaredNames)

- Language.Haskell.Refact.API: hsFreeAndDeclaredNameStrings :: (Data t, Outputable t) => t -> RefactGhc ([String], [String])

+ Language.Haskell.Refact.API: hsFreeAndDeclaredNameStrings :: (Data t) => t -> RefactGhc ([String], [String])

- Language.Haskell.Refact.API: hsVisibleNamesRdr :: (FindEntity t1, Data t2, Outputable t1) => t1 -> t2 -> RefactGhc [String]

+ Language.Haskell.Refact.API: hsVisibleNamesRdr :: (Data t2) => Name -> t2 -> RefactGhc [String]

- Language.Haskell.Refact.API: isExplicitlyExported :: Name -> RenamedSource -> Bool

+ Language.Haskell.Refact.API: isExplicitlyExported :: NameMap -> Name -> ParsedSource -> Bool

- Language.Haskell.Refact.API: isFunBindP :: HsDeclP -> Bool

+ Language.Haskell.Refact.API: isFunBindP :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.API: isFunOrPatName :: (Data t) => Name -> t -> Bool

+ Language.Haskell.Refact.API: isFunOrPatName :: (Data t) => NameMap -> Name -> t -> Bool

- Language.Haskell.Refact.API: isPatBindP :: HsDeclP -> Bool

+ Language.Haskell.Refact.API: isPatBindP :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.API: isSimplePatDecl :: (DataId t) => LHsDecl t -> Bool

+ Language.Haskell.Refact.API: isSimplePatDecl :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.API: locToExp :: (Data t, Typeable n) => SimpPos -> SimpPos -> t -> Maybe (Located (HsExpr n))

+ Language.Haskell.Refact.API: locToExp :: (Data t, Typeable n) => SimpPos -> SimpPos -> t -> Maybe (LHsExpr n)

- Language.Haskell.Refact.API: renamePN :: (Data t) => Name -> Name -> Bool -> t -> RefactGhc t

+ Language.Haskell.Refact.API: renamePN :: (Data t) => Name -> Name -> HowToQual -> t -> RefactGhc t

- Language.Haskell.Refact.HaRe: Options :: OutputOpts -> Programs -> [GHCOption] -> [(FilePath, Maybe FilePath)] -> Options

+ Language.Haskell.Refact.HaRe: Options :: OutputOpts -> Programs -> [GHCOption] -> [(FilePath, Maybe FilePath)] -> String -> Options

- Language.Haskell.Refact.Utils.TypeUtils: addItemsToExport :: ParsedSource -> Maybe PName -> Bool -> Either [String] [LIE RdrName] -> RefactGhc ParsedSource

+ Language.Haskell.Refact.Utils.TypeUtils: addItemsToExport :: ParsedSource -> Maybe Name -> Bool -> Either [RdrName] [LIE RdrName] -> RefactGhc ParsedSource

- Language.Haskell.Refact.Utils.TypeUtils: addItemsToImport :: ModuleName -> ParsedSource -> [RdrName] -> RefactGhc ParsedSource

+ Language.Haskell.Refact.Utils.TypeUtils: addItemsToImport :: ModuleName -> Maybe Name -> Either [RdrName] [LIE RdrName] -> ParsedSource -> RefactGhc ParsedSource

- Language.Haskell.Refact.Utils.TypeUtils: causeNameClashInExports :: Name -> Name -> ModuleName -> RenamedSource -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: causeNameClashInExports :: NameMap -> Name -> Name -> ModuleName -> ParsedSource -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: isExplicitlyExported :: Name -> RenamedSource -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: isExplicitlyExported :: NameMap -> Name -> ParsedSource -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: isFunBindP :: HsDeclP -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: isFunBindP :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: isFunOrPatName :: (Data t) => Name -> t -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: isFunOrPatName :: (Data t) => NameMap -> Name -> t -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: isPatBindP :: HsDeclP -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: isPatBindP :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: isSimplePatDecl :: (DataId t) => LHsDecl t -> Bool

+ Language.Haskell.Refact.Utils.TypeUtils: isSimplePatDecl :: LHsDecl RdrName -> Bool

- Language.Haskell.Refact.Utils.TypeUtils: locToExp :: (Data t, Typeable n) => SimpPos -> SimpPos -> t -> Maybe (Located (HsExpr n))

+ Language.Haskell.Refact.Utils.TypeUtils: locToExp :: (Data t, Typeable n) => SimpPos -> SimpPos -> t -> Maybe (LHsExpr n)

- Language.Haskell.Refact.Utils.TypeUtils: renamePN :: (Data t) => Name -> Name -> Bool -> t -> RefactGhc t

+ Language.Haskell.Refact.Utils.TypeUtils: renamePN :: (Data t) => Name -> Name -> HowToQual -> t -> RefactGhc t

- Language.Haskell.Refact.Utils.Variables: definingTyClDeclsNames :: (Data t) => [Name] -> t -> [LTyClDecl Name]

+ Language.Haskell.Refact.Utils.Variables: definingTyClDeclsNames :: (Data t) => NameMap -> [Name] -> t -> [LTyClDecl RdrName]

- Language.Haskell.Refact.Utils.Variables: hsFDsFromInsideRdr :: (Data t) => NameMap -> t -> RefactGhc (FreeNames, DeclaredNames)

+ Language.Haskell.Refact.Utils.Variables: hsFDsFromInsideRdr :: (Data t) => NameMap -> t -> (FreeNames, DeclaredNames)

- Language.Haskell.Refact.Utils.Variables: hsFreeAndDeclaredNameStrings :: (Data t, Outputable t) => t -> RefactGhc ([String], [String])

+ Language.Haskell.Refact.Utils.Variables: hsFreeAndDeclaredNameStrings :: (Data t) => t -> RefactGhc ([String], [String])

- Language.Haskell.Refact.Utils.Variables: hsVisibleDsRdr :: (FindEntity e, Outputable e, Data t) => NameMap -> e -> t -> RefactGhc DeclaredNames

+ Language.Haskell.Refact.Utils.Variables: hsVisibleDsRdr :: (Data t) => NameMap -> Name -> t -> RefactGhc DeclaredNames

- Language.Haskell.Refact.Utils.Variables: hsVisibleNamesRdr :: (FindEntity t1, Data t2, Outputable t1) => t1 -> t2 -> RefactGhc [String]

+ Language.Haskell.Refact.Utils.Variables: hsVisibleNamesRdr :: (Data t2) => Name -> t2 -> RefactGhc [String]

Files

ChangeLog +3/−0
HaRe.cabal +24/−16
elisp/hare.el +26/−26
src/Language/Haskell/Refact/API.hs +45/−44
src/Language/Haskell/Refact/HaRe.hs +9/−12
src/Language/Haskell/Refact/Refactoring/AddRmParam.hs +855/−586
src/Language/Haskell/Refact/Refactoring/Case.hs +32/−4
src/Language/Haskell/Refact/Refactoring/DupDef.hs +18/−11
src/Language/Haskell/Refact/Refactoring/MoveDef.hs +87/−69
src/Language/Haskell/Refact/Refactoring/Renaming.hs +35/−33
src/Language/Haskell/Refact/Refactoring/SwapArgs.hs +30/−4
src/Language/Haskell/Refact/Utils/Binds.hs +0/−425
src/Language/Haskell/Refact/Utils/ExactPrint.hs +92/−3
src/Language/Haskell/Refact/Utils/GhcModuleGraph.hs +15/−0
src/Language/Haskell/Refact/Utils/GhcUtils.hs +2/−3
src/Language/Haskell/Refact/Utils/Monad.hs +6/−0
src/Language/Haskell/Refact/Utils/MonadFunctions.hs +68/−5
src/Language/Haskell/Refact/Utils/TypeSyn.hs +3/−1
src/Language/Haskell/Refact/Utils/TypeUtils.hs +2541/−2241
src/Language/Haskell/Refact/Utils/Types.hs +10/−7
src/Language/Haskell/Refact/Utils/Utils.hs +18/−12
src/Language/Haskell/Refact/Utils/Variables.hs +1584/−2453
src/MainHaRe.hs +263/−145
test/AddRmParamSpec.hs +495/−0
test/GhcUtilsSpec.hs +33/−18
test/RenamingSpec.hs +2/−2
test/TestUtils.hs +29/−12
test/TypeUtilsSpec.hs +3774/−3795
test/UtilsSpec.hs +17/−3
test/testdata/AddOneParameter/A1.expected.hs +10/−0
test/testdata/AddOneParameter/A1.hs +10/−0
test/testdata/AddOneParameter/A2.expected.hs +12/−0
test/testdata/AddOneParameter/A2.hs +12/−0
test/testdata/AddOneParameter/A3.expected.hs +6/−0
test/testdata/AddOneParameter/A3.hs +6/−0
test/testdata/AddOneParameter/C1.expected.hs +10/−0
test/testdata/AddOneParameter/C1.hs +10/−0
test/testdata/AddOneParameter/C2.expected.hs +12/−0
test/testdata/AddOneParameter/C2.hs +12/−0
test/testdata/AddOneParameter/D1.expected.hs +15/−0
test/testdata/AddOneParameter/D1.hs +13/−0
test/testdata/AddOneParameter/D2.expected.hs +16/−0
test/testdata/AddOneParameter/D2.hs +14/−0
test/testdata/AddOneParameter/D3.expected.hs +14/−0
test/testdata/AddOneParameter/D3.hs +12/−0
test/testdata/AddOneParameter/FunIn1.expected.hs +13/−0
test/testdata/AddOneParameter/FunIn1.hs +11/−0
test/testdata/AddOneParameter/FunIn2.expected.hs +13/−0
test/testdata/AddOneParameter/FunIn2.hs +11/−0
test/testdata/AddOneParameter/FunIn3.expected.hs +14/−0
test/testdata/AddOneParameter/FunIn3.hs +12/−0
test/testdata/AddOneParameter/FunIn4.expected.hs +11/−0
test/testdata/AddOneParameter/FunIn4.hs +9/−0
test/testdata/AddOneParameter/FunIn5.hs +12/−0
test/testdata/AddOneParameter/FunIn6.expected.hs +13/−0
test/testdata/AddOneParameter/FunIn6.hs +11/−0
test/testdata/AddOneParameter/MultiFun1.expected.hs +13/−0
test/testdata/AddOneParameter/MultiFun1.hs +11/−0
test/testdata/AddOneParameter/Nested.expected.hs +14/−0
test/testdata/AddOneParameter/Nested.hs +12/−0
test/testdata/AddOneParameter/PatIn1.expected.hs +12/−0
test/testdata/AddOneParameter/PatIn1.hs +10/−0
test/testdata/AddOneParameter/PatIn2.hs +10/−0
test/testdata/LiftOneLevel/C1.hs +2/−3
test/testdata/LiftOneLevel/C1.hs.expected +0/−1
test/testdata/LiftOneLevel/D1.hs +1/−1
test/testdata/Renaming/ConstructorIn3.hs +2/−2
test/testdata/Renaming/D1.hs +3/−3
test/testdata/Renaming/D3.hs +3/−3
test/testdata/Renaming/D4.hs +3/−3
test/testdata/Renaming/LayoutIn2.hs +2/−3
test/testdata/Renaming/LayoutIn2.hs.expected +0/−1
test/testdata/RmOneParameter/A1.expected.hs +8/−0
test/testdata/RmOneParameter/A1.hs +8/−0
test/testdata/RmOneParameter/A2.expected.hs +8/−0
test/testdata/RmOneParameter/A2.hs +8/−0
test/testdata/RmOneParameter/D1.expected.hs +13/−0
test/testdata/RmOneParameter/D1.hs +13/−0
test/testdata/RmOneParameter/D2.expected.hs +14/−0
test/testdata/RmOneParameter/D2.hs +14/−0
test/testdata/RmOneParameter/FunIn0.expected.hs +13/−0
test/testdata/RmOneParameter/FunIn0.hs +13/−0
test/testdata/RmOneParameter/FunIn1.expected.hs +12/−0
test/testdata/RmOneParameter/FunIn1.hs +12/−0
test/testdata/RmOneParameter/FunIn2.expected.hs +16/−0
test/testdata/RmOneParameter/FunIn2.hs +14/−0
test/testdata/RmOneParameter/FunIn2a.expected.hs +16/−0
test/testdata/RmOneParameter/FunIn2a.hs +14/−0
test/testdata/RmOneParameter/FunIn3.expected.hs +11/−0
test/testdata/RmOneParameter/FunIn3.hs +11/−0
test/testdata/RmOneParameter/FunIn4.expected.hs +11/−0
test/testdata/RmOneParameter/FunIn4.hs +11/−0
test/testdata/RmOneParameter/FunIn5.expected.hs +13/−0
test/testdata/RmOneParameter/FunIn5.hs +13/−0
test/testdata/RmOneParameter/FunIn6.expected.hs +10/−0
test/testdata/RmOneParameter/FunIn6.hs +10/−0
test/testdata/RmOneParameter/FunIn7.expected.hs +13/−0
test/testdata/RmOneParameter/FunIn7.hs +13/−0
test/testdata/RmOneParameter/MultiFun1.expected.hs +11/−0
test/testdata/RmOneParameter/MultiFun1.hs +11/−0
test/testdata/RmOneParameter/SubFun1.expected.hs +10/−0
test/testdata/RmOneParameter/SubFun1.hs +10/−0
test/testdata/RmOneParameter/SubFun2.expected.hs +12/−0
test/testdata/RmOneParameter/SubFun2.hs +12/−0
test/testdata/RmOneParameter/SubFun3.expected.hs +11/−0
test/testdata/RmOneParameter/SubFun3.hs +11/−0
test/testdata/cabal/foo/foo.cabal +2/−2
test/testdata/testdata.cabal +61/−21

ChangeLog view

@@ -1,3 +1,6 @@+2016-08-03 v0.8.3.0+	* Update for GHC 8.0.1+	* Use ghc-mod version to 5.6 now it is released 2016-01-20 v0.8.2.3 	* Use ghc-mod version to 5.5 now it is released 	* Expose commands working in RefactGhc, so the ghc-mod session can

HaRe.cabal view

@@ -1,7 +1,7 @@ Name:                           HaRe-Version:                        0.8.2.3+Version:                        0.8.3.0 Author:                         Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman-Maintainer:                     Alan Zimmerman+Maintainer:                     Alan Zimmerman (alan.zimm@gmail.com) Stability:                      Alpha Bug-Reports:                    http://github.com/RefactoringTools/HaRe/issues License:                        BSD3@@ -17,8 +17,10 @@    .    From version 0.8.0.0, GHC 7.10.2 is supported.    .-   It is tested against GHC 7.10.2 (via travis-ci.org)+   From version 0.8.3.0, GHC 8.0.1 is supported.    .+   It is tested against GHC 7.10.3 and GHC 8.0.1 (via travis-ci.org)+   .    It currently only has emacs integration built in, community input    welcome for others.    .@@ -40,12 +42,14 @@ Cabal-Version:                  >= 1.8 Build-Type:                     Simple -tested-with:                    GHC == 7.10.2, GHC == 7.10.3+tested-with:                    GHC == 7.10.3, GHC == 8.0.1  data-files:                     elisp/*.el                                 configure.sh                                 test/testdata/*.cabal                                 test/testdata/*.hs+                                test/testdata/AddOneParameter/*.hs+                                test/testdata/AddOneParameter/*.expected.hs                                 test/testdata/Case/*.hs                                 test/testdata/Case/*.hs.expected                                 test/testdata/Case/*.hs.expected.dd@@ -72,6 +76,8 @@                                 test/testdata/Renaming/*.expected.hs                                 test/testdata/Renaming/*.hs                                 test/testdata/Renaming/*.hs.expected+                                test/testdata/RmOneParameter/*.expected.hs+                                test/testdata/RmOneParameter/*.hs                                 test/testdata/Simple/*.hs                                 test/testdata/Simple/*.hs.expected                                 test/testdata/SwapArgs/*.hs@@ -108,7 +114,7 @@  Library         -- GHC 7.10.2 ships with base 4.8.1.0-        Build-Depends:          base >= 4.8.1.0  && < 4.9+        Build-Depends:          base >= 4.8.1.0  && < 5                                 , containers                                 , directory @@ -121,7 +127,7 @@                                 , ghc-paths                                 , ghc-prim                                 , ghc-syb-utils-                                , ghc-mod >= 5.5.0.0+                                , ghc-mod >= 5.6.0.0                                 , mtl                                 , old-time                                 , pretty@@ -133,7 +139,7 @@                                 , time                                 , Strafunski-StrategyLib                                 , syz-                                , ghc-exactprint >= 0.5.0.1+                                , ghc-exactprint >= 0.5.2.1                                 , monad-control                                 , Cabal >= 1.22 @@ -151,7 +157,6 @@            , Language.Haskell.Refact.Refactoring.RoundTrip            , Language.Haskell.Refact.Refactoring.Simple            , Language.Haskell.Refact.Refactoring.SwapArgs-           , Language.Haskell.Refact.Utils.Binds            , Language.Haskell.Refact.Utils.ExactPrint            , Language.Haskell.Refact.Utils.GhcBugWorkArounds            , Language.Haskell.Refact.Utils.GhcModuleGraph@@ -179,7 +184,7 @@           ./src          -- GHC 7.10.2 ships with base 4.8.1.0-        Build-Depends:          base >= 4.8.1.0  && < 4.9+        Build-Depends:          base >= 4.8.1.0  && < 5                                 , array                                 , containers                                 , directory@@ -193,8 +198,11 @@                                 , ghc-paths                                 , ghc-prim                                 , ghc-syb-utils-                                , ghc-mod >= 5.5.0.0+                                , gitrev >= 1.1+                                , ghc-mod >= 5.6.0.0                                 , mtl+                                , optparse-applicative+                                , optparse-simple                                 , old-time                                 , parsec >= 3.1.6                                 , pretty@@ -206,7 +214,7 @@                                 , hslogger                                 , Strafunski-StrategyLib                                 , syz-                                , ghc-exactprint >= 0.5.0.1+                                , ghc-exactprint >= 0.5.2.1                                 , monad-control                                 , Cabal >= 1.22                                 -- , Paths_HaRe@@ -233,7 +241,8 @@     src     test   other-modules:-      CaseSpec+      AddRmParamSpec+    , CaseSpec     , DupDefSpec     , GhcUtilsSpec     , LocUtilsSpec@@ -252,7 +261,6 @@     -- , Language.Haskell.Refact.Refactoring.AddRmParam     -- , Language.Haskell.Refact.Refactoring.Case     -- , Language.Haskell.Refact.Refactoring.RoundTrip-    -- , Language.Haskell.Refact.Utils.Binds     -- , Language.Haskell.Refact.Utils.ExactPrint     -- , Language.Haskell.Refact.Utils.GhcModuleGraph     -- , Language.Haskell.Refact.Utils.GhcUtils@@ -268,7 +276,7 @@     -- , Paths_HaRe   build-depends:       -- GHC 7.10.2 ships with base 4.8.1.0-      base        >= 4.8.1.0  && < 4.9+      base        >= 4.8.1.0  && < 5     , Diff >= 0.3.0     , HUnit     , QuickCheck  >= 2.5@@ -285,7 +293,7 @@     , ghc-paths     , ghc-prim     , ghc-syb-utils-    , ghc-mod >= 5.5.0.0+    , ghc-mod >= 5.6.0.0     , hspec     , mtl     , old-time@@ -300,7 +308,7 @@     , hslogger     , Strafunski-StrategyLib     , syz-    , ghc-exactprint >= 0.5.0.1+    , ghc-exactprint >= 0.5.2.1     , monad-control     , Cabal >= 1.22     -- , Paths_HaRe

elisp/hare.el view

@@ -382,37 +382,37 @@ ;;          ))))))  (defun current-time-suffix()-  "Generate a time stamp suffix in ISO 8601 format for backed up-   files, including a leading '.'"-  (format-time-string ".%Y-%m-%dT%T%z")+  "Generate a time stamp suffix for backed up files, including a leading '.'"+  (format-time-string ".%Y%m%d%H%M%S")   )  (defun delete-swp-file-and-buffers (files)- "delete those .refactored file and buffers generated by the refactorer. NOTE:also renames the files"- (dolist (f files)-   (let (old-file-name new-file-name swp-file-name)-     (setq old-file-name (elt f 0))-     (setq new-file-name (elt f 1))-     (setq swp-file-name (elt f 2))+  "delete those .refactored file and buffers generated by the refactorer. NOTE:also renames the files"+  (let ((suf (current-time-suffix)))+	(dolist (f files)+	  (let (old-file-name new-file-name swp-file-name)+		(setq old-file-name (elt f 0))+		(setq new-file-name (elt f 1))+		(setq swp-file-name (elt f 2)) -     ;; At this stage there are no file renaming operations, so we-     ;; simply need to replace old-file-name with swp-file-name-     (rename-file old-file-name (concat old-file-name (current-time-suffix)))-     (rename-file swp-file-name old-file-name)+		;; At this stage there are no file renaming operations, so we+		;; simply need to replace old-file-name with swp-file-name+		(rename-file old-file-name (concat old-file-name suf))+		(rename-file swp-file-name old-file-name) -     (let ((swp-buff (get-file-buffer-1 swp-file-name)))-       (if swp-buff (kill-buffer swp-buff)-         nil))-     ;(delete-file  swp-file-name)-     (let ((buffer (get-file-buffer-1 old-file-name)))-       (if buffer-           (if (equal old-file-name new-file-name)-               (with-current-buffer buffer (revert-buffer nil t t))-             (with-current-buffer buffer-               (set-visited-file-name new-file-name)-               ;;(delete-file old-file-name)-               (revert-buffer nil t t)))-         nil)))))+		(let ((swp-buff (get-file-buffer-1 swp-file-name)))+		  (if swp-buff (kill-buffer swp-buff)+			nil))+										;(delete-file  swp-file-name)+		(let ((buffer (get-file-buffer-1 old-file-name)))+		  (if buffer+			  (if (equal old-file-name new-file-name)+				  (with-current-buffer buffer (revert-buffer nil t t))+				(with-current-buffer buffer+				  (set-visited-file-name new-file-name)+				  ;;(delete-file old-file-name)+				  (revert-buffer nil t t)))+			nil))))))  (defun abort-changes()   "abort the refactoring results"

src/Language/Haskell/Refact/API.hs view

@@ -20,6 +20,8 @@         , logm        , logDataWithAnns+       , logExactprint+       , logParsedSource   -- * from `Language.Haskell.Refact.Utils.Utils` @@ -40,7 +42,9 @@        , clientModsAndFiles        , serverModsAndFiles +       , stripCallStack +  -- * from `Language.Haskell.Refact.Utils.MonadFunctions`         -- ** Conveniences for state access@@ -75,6 +79,9 @@        , setStateStorage        , getStateStorage +       -- * Parsing source+       , parseDeclWithAnns+        -- , logm  @@ -104,45 +111,40 @@    , inScopeInfo, isInScopeAndUnqualified, isInScopeAndUnqualifiedGhc, inScopeNames    , isExported, isExplicitlyExported, modIsExported    , equivalentNameInNewMod+   , hsQualifier      -- *** Variable analysis     , isFieldName     , isClassName     , isInstanceName-    , hsPNs-    , hsBinds-    , HsValBinds(..)-    ,isDeclaredIn,isDeclaredInRdr-    ,FreeNames(..),DeclaredNames(..)-    ,hsFreeAndDeclaredPNsOld, hsFreeAndDeclaredNameStrings-    ,hsFreeAndDeclaredRdr-    ,hsFreeAndDeclaredPNs-    ,hsFreeAndDeclaredGhc-    ,getDeclaredTypes-    ,getFvs, getFreeVars, getDeclaredVars -- These two should replace hsFreeAndDeclaredPNs+    , hsTypeVbls+    , hsNamessRdr+    , isDeclaredInRdr+    , FreeNames(..),DeclaredNames(..)+    , hsFreeAndDeclaredNameStrings+    , hsFreeAndDeclaredRdr+    , hsFreeAndDeclaredPNs+    , getDeclaredVarsRdr -    ,hsVisiblePNs, hsVisiblePNsRdr, hsVisibleNames-    ,hsVisibleNamesRdr-    ,hsFDsFromInsideRdr, hsFDNamesFromInsideRdr-    ,hsFDsFromInside, hsFDNamesFromInside-    ,hsVisibleDs-    ,rdrName2Name, rdrName2NamePure+    , hsVisibleNamesRdr+    , hsFDsFromInsideRdr, hsFDNamesFromInsideRdr, hsFDNamesFromInsideRdrPure+    , hsVisibleDsRdr+    , rdrName2Name, rdrName2NamePure      -- *** Property checking     ,isVarId,isConId,isOperator,isTopLevelPN,isLocalPN,isNonLibraryName -- ,isTopLevelPNT     ,isQualifiedPN, isFunOrPatName,isTypeSig     ,isFunBindP,isFunBindR,isPatBindP,isPatBindR,isSimplePatBind,isSimplePatDecl     ,isComplexPatBind,isComplexPatDecl,isFunOrPatBindP,isFunOrPatBindR-    ,usedWithoutQualR,isUsedInRhs+    ,usedWithoutQualR     ,findNameInRdr-    ,findPNT,findPN,findAllNameOccurences-    ,findPNs, findNamesRdr, findEntity, findEntity'+    ,findNamesRdr, findEntity, findEntity'     ,sameOccurrence     , findIdForName     , getTypeForName-    ,defines, definesP,definesTypeSig-    ,sameBind,sameBindRdr-    ,UsedByRhs(..)+    , definesTypeSigRdr,definesSigDRdr+    , sameBindRdr+    , UsedByRhs(..)      -- *** Modules and files     , isMainModule@@ -150,34 +152,37 @@      -- *** Locations     ,defineLoc, useLoc, locToExp-    ,locToName, locToRdrName+    ,findLRdrName+    -- ,locToName+    ,locToNameRdrPure+    ,locToRdrName     ,getName   -- * Program transformation     -- *** Adding     ,addDecl, addItemsToImport, addItemsToExport, addHiding-    ,addParamsToDecls, addActualParamsToRhs, addImportDecl, duplicateDecl -- , moveDecl+    ,addParamsToDecls, addParamsToSigs, addActualParamsToRhs, addImportDecl, duplicateDecl+     -- *** Removing     ,rmDecl, rmTypeSig, rmTypeSigs      -- *** Updating     -- ,Update(update)-    ,rmQualifier,qualifyToplevelName,renamePN,autoRenameLocalVar+    ,rmQualifier,qualifyToplevelName,renamePN, HowToQual(..), autoRenameLocalVar      -- *** Identifiers, expressions, patterns and declarations-    ,ghcToPN,lghcToPN, expToName, expToNameRdr-    ,patToNameRdr-    ,nameToString-    ,patToPNT ,pNtoPat-    , definedPNs, definedPNsRdr,definedNamesRdr+    , expToNameRdr+    , patToNameRdr+    , nameToString+    , pNtoPat+    , definedPNsRdr,definedNamesRdr     , definingDeclsRdrNames, definingDeclsRdrNames', definingSigsRdrNames-    , definingDeclsNames, definingDeclsNames', definingSigsNames     , definingTyClDeclsNames-    , allNames      -- *** Others     , divideDecls-    , mkRdrName,mkNewGhcName,mkNewName,mkNewToplevelName+    , mkRdrName,mkQualifiedRdrName,mkNewGhcName,mkNewName,mkNewToplevelName+    , registerRdrName      -- The following functions are not in the the API yet.     , causeNameClashInExports@@ -187,18 +192,11 @@     -- ** Typed AST traversals (added by CMB)     -- ** Miscellous -    -- ** Debug stuff-    , getParsedForRenamedLPat-    , getParsedForRenamedName-    , getParsedForRenamedLocated-    , stripLeadingSpaces-  -- ** from `Language.Haskell.Refact.Utils.GhcUtils`     -- ** SYB versions     , everywhereMStaged'     , everywhereStaged     , everywhereStaged'-    , onelayerStaged     , listifyStaged      -- ** Scrap Your Zipper versions@@ -225,12 +223,15 @@   , NameMap   -- * from `Language.Haskell.Refact.Utils.ExactPrint'`- , replace- , setRefactAnns+  , replace+  , setRefactAnns+  , setAnnKeywordDP+  , copyAnn+  , clearPriorComments+  , balanceAllComments   ) where -import Language.Haskell.Refact.Utils.Binds import Language.Haskell.Refact.Utils.ExactPrint import Language.Haskell.Refact.Utils.GhcUtils import Language.Haskell.Refact.Utils.GhcVersionSpecific

src/Language/Haskell/Refact/HaRe.hs view

@@ -11,24 +11,21 @@  , GM.defaultOptions   -- * Refactorings- , ifToCase- , compIfToCase- , duplicateDef- , compDuplicateDef- , liftToTopLevel- , compLiftToTopLevel- , liftOneLevel- , compLiftOneLevel- , demote- , compDemote- , rename- , compRename+ , ifToCase,        compIfToCase+ , duplicateDef,    compDuplicateDef+ , liftToTopLevel,  compLiftToTopLevel+ , liftOneLevel,    compLiftOneLevel+ , demote,          compDemote+ , rename,          compRename+ , addOneParameter, compAddOneParameter+ , rmOneParameter,  compRmOneParameter  -- , swapArgs  , roundTrip   ) where +import Language.Haskell.Refact.Refactoring.AddRmParam import Language.Haskell.Refact.Refactoring.Case import Language.Haskell.Refact.Refactoring.DupDef import Language.Haskell.Refact.Refactoring.MoveDef

src/Language/Haskell/Refact/Refactoring/AddRmParam.hs view

@@ -1,586 +1,855 @@-{-# 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-                                             `adhocTP` inLetStmt)-                           `choiceTP` failure) mod) ((tokList,unmodified),(-1000,0))-      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--             --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 mod (m::HsModuleP) = error "Refactoring failed"--             doAdding parent ds-               = if paramNameOk pn newParam ds-                   then-                    do ds' <- addParamsToDecls ds pn [nameToPN 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."--}---- -----------------------------------------------------------------------paramNameOk = assert False undefined-{----- check whether the new parameter is a legal.--paramNameOk pn newParam t = (fromMaybe True) (applyTU (once_tdTU (failTU `adhocTU` decl)) t)-  where-   decl ((Dec (HsFunBind _ matches@((HsMatch _ fun pats rhs ds):ms)))::HsDeclP)-    | pNTtoPN fun == pn-    = do results'<-mapM checkInMatch matches-         Just (all (==True) results')-   decl pat@(Dec (HsPatBind loc p rhs ds))-    | patToPN p == pn-    = do (f,d) <- hsFDNamesFromInside pat-         if elem newParam (f `union` d)-            then  error "The new parameter name will cause name clash or semantics change, please select another name!"-            else Just True-   decl (Dec (HsPatBind _ p _ _))-     | patToPN p /= pn && elem pn (hsPNs p)-      = error "Parameter can not be added to complex pattern binding"-   decl _=mzero--   checkInMatch match-     = do (f,d) <- hsFDNamesFromInside match-          if elem newParam (f `union` d)-           then error "The new parameter name will cause name clash or semantics change, please choose another name!"-           else return True--}--- ----------------------------------------------------------------------addDefaultActualArgDecl = assert False undefined-{----add the default argument declaration right after the declaration defining pn-addDefaultActualArgDecl defaultParamPName parent pn isExported-   =if not (findEntity pn parent) && not isExported-      then return parent-      else addDecl parent (Just pn) (defaultArgDecl,Nothing) True-   where-      defaultArgDecl= [Dec (HsPatBind loc0 (nameToPat (pNtoName defaultParamPName))(HsBody (nameToExp "undefined"))[])]---}--- -----------------------------------------------------------------------mkLocalDefaultArgName = assert False undefined-{----suppose function name is f, parameter name is p, then the default argument name is like f_p.-mkLocalDefaultArgName fun paramName modName t- =do (f,d)<-hsFDNamesFromInside t-     vs<-hsVisibleNames fun t-     let name=mkNewName ((pNtoName fun)++"_"++paramName) (nub (f `union` d `union` vs)) 0-     return (PN (UnQual name) (S loc0))---}--- ----------------------------------------------------------------------{--mkTopLevelDefaultArgName fun paramName fileName modName inscopeNames t- =do (f,d)<-hsFDNamesFromInside t-     let name=mkNewName ((pNtoName fun)++"_"++paramName) (nub (f `union` d `union` inscopeNames)) 0-     let loc =  SrcLoc fileName 0 (-1000) (-1000)-     return (PN (UnQual name) (G modName name (N (Just loc))))---}--- ----------------------------------------------------------------------addDefaultActualArg = assert False undefined-{---addDefaultActualArg recursion pn argPName-        = if recursion then applyTP (stop_tdTP (failTP `adhocTP` funApp))-                       else applyTP (stop_tdTP (failTP `adhocTP` inDecl-                                                       `adhocTP` funApp))-       where-         inDecl (fun@(Dec (HsFunBind _  ((HsMatch _ (PNT pname _ _) _ _ _):ms)))::HsDeclP)-           | pn == pname-           = return fun--         inDecl (pat@(Dec (HsPatBind loc1 ps rhs ds))::HsDeclP)-           | pn == patToPN  ps-           = return pat-         inDecl _ = mzero--         funApp (exp@(Exp (HsId (HsVar (PNT pname _ _))))::HsExpP)-          |pname==pn-           = update exp (Exp (HsParen (Exp (HsApp exp (pNtoExp argPName))))) exp--         funApp _ = mzero---}--- -----------------------------------------------------------------------addArgToSig = assert False undefined-{----Add type arg to type siginature-addArgToSig pn decls-   = let (before,after)=break (\d ->definesTypeSig pn d) decls-     in if  after==[]-       then  return decls-       else  do newSig<-addArgToSig' [(head after)]  --no problem with head.-                return (before++newSig++(tail after))--    where-       addArgToSig' sig@[(Dec (HsTypeSig loc is c tp))]-          =do let tVar=mkNewTypeVarName sig-                  typeVar=newTypeVar tVar tp-              let newSig=if length is==1-                           then  --the type sig only defines the type for pn-                                [Dec (HsTypeSig loc is c typeVar)]-                           else  --otherwise, seperate it into two type signatures.-                               [Dec (HsTypeSig loc (filter (\x->pNTtoPN x/=pn) is) c tp),-                                Dec (HsTypeSig loc (filter (\x->pNTtoPN x==pn) is) c typeVar)]-              update sig newSig sig--       --compose a type application using type expressions tv and tp-       newTypeVar tVar tp-         =(Typ (HsTyFun (Typ (HsTyVar (PNT (PN (UnQual tVar) (S loc0))-           (Type (TypeInfo {defType=Nothing, constructors=[], fields=[]})) (N (Just loc0))))) tp))--       {- make a fresh type variable name. the new name is the first letter in the alphabet which is not-          used in the type signature. -}-       mkNewTypeVarName sig-          =mkNewName "a" $ map pNtoName $ (snd.hsTypeVbls) sig-             where mkNewName initName v-                     =if elem initName v-                         then mkNewName ((intToDigit (digitToInt(head initName)+1)):tail initName) v-                         else initName--addArgInClientMod pnt defaultArg  serverModName ((inscps, exps, mod,ts), fileName)- = let qual = hsQualifier pnt inscps-       pn = pNTtoPN pnt-   in if qual == []-          then return ((fileName,unmodified), (ts,mod))-          else do (mod',((ts',m), _))<--                      runStateT (do mod'<-addItemsToImport serverModName  (Just pn) (Left [pNtoName defaultArg]) mod-                                    mod''<-addItemsToExport mod (Just pn) False (Left [pNtoName defaultArg])-                                    if isInScopeAndUnqualified (pNtoName pn) inscps-                                       then addDefaultActualArgInClientMod  pn  (head qual) defaultArg False mod''-                                       else addDefaultActualArgInClientMod  pn  (head qual) defaultArg True  mod'')-                          ((ts,unmodified), (-1000,0))-                  return ((fileName,m),(ts',mod'))-----add default actual argument to pn in all the calling places.-addDefaultActualArgInClientMod pn qual argPName toBeQualified t-   = applyTP (stop_tdTP (failTP `adhocTP` funApp)) t-  where-    funApp (exp@(Exp (HsId (HsVar pnt@(PNT pname _ _))))::HsExpP)-      | pname == pn-       = do vs <- hsVisibleNames pnt t-            let argExp=if toBeQualified || elem (pNtoName argPName) vs-                         then pNtoExp (qualifyPName qual argPName)-                         else pNtoExp argPName-                newExp =(Exp (HsParen (Exp (HsApp exp argExp))))-            update exp newExp exp-    funApp _=mzero--myfst (a,_,_,_) = a--------------------------------End of adding a parameter-------------------------------------------------------------------------------------------------------------------------------------------{-Refactoring: Remove a parameter-  Description: The refactoring removes a user specified formal parameter in a function binding,and-               the corresponding actual parameters in all calling places of this function. The-               condition acompanying this refactoring is that the parameter to be removed is not being used.--  --To select a parameter, just stop the cursor at any position between the start and end position of this parameter.--}--------------------------------------------------------------------------------------------------------rmOneParameter args- =do let fileName=args!!0-         row=read (args!!1)::Int-         col=read (args!!2)::Int-     (inscps, exps, mod, tokList)<-parseSourceFile fileName-     --pn is the function names.-     --nth is the nth paramter of pn is to be removed,index starts form 0.-     let (pnt,nth)=getParam tokList (row,col) mod-         pn=pNTtoPN pnt-     if pn/=defaultPN-       then do (mod',((ts',m), _))<-doRmParam pn nth mod fileName tokList-               if isExported pnt exps-                then do modName <- RefacUtils.fileNameToModName fileName-                        clients<-clientModsAndFiles modName-                        refactoredClients<-mapM (rmParamInClientMod pnt nth) clients-                        writeRefactoredFiles False $ ((fileName,m),(ts',mod')):refactoredClients-                else  writeRefactoredFiles  False [((fileName,m), (ts',mod'))]-       else error "Invalid cursor position!"----pn: function name; nth: the index of the parameter to be removed.-doRmParam pn nth mod fileName tokList-       =runStateT (applyTP ((once_tdTP (failTP `adhocTP` inMod-                                              `adhocTP` inMatch-                                              `adhocTP` inPat-                                              `adhocTP` inLet-                                              `adhocTP` inAlt-                                              `adhocTP` inLetStmt)) `choiceTP` failure) mod)-                                           ((tokList,unmodified),(-1000,0))-      where-             --1. pn is declared in top level.-             inMod (mod@(HsModule loc name exps imps ds):: HsModuleP)-                |definingDecls [pn] ds False  False/=[] = doRemoving mod  ds-             inMod _ =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 /=[] = doRemoving 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/=[]  = doRemoving 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/=[] = doRemoving 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/=[]  = doRemoving  alt  ds-             inAlt _=mzero--             --6.pn is declared locally in a let statement.-             inLetStmt (letStmt@(HsLetStmt ds stmts):: HsStmtP)-                | definingDecls [pn] ds False  False/=[]  = doRemoving letStmt ds-             inLetStmt _=mzero--             failure=idTP `adhocTP` mod-                     where mod (m::HsModuleP)=error "Refactoring failed"--             doRemoving parent  ds  --PROBLEM: How about doRemoving fails?-                =do rmFormalArg pn nth False True =<<rmNthArgInFunCall pn nth False ds-                    ds'<-rmNthArgInSig pn nth =<<rmFormalArg pn nth True False  ds-                    rmNthArgInFunCall pn nth True (replaceDecls parent ds')--             -- just remove the nth formal parameter.-             rmFormalArg pn nth updateToks checking-                =applyTP (stop_tdTP (failTP `adhocTP` rmInMatch))--               where-                 rmInMatch (match@(HsMatch loc  fun  pats rhs decls)::HsMatchP) --a formal parameter only exists in a match-                   |pNTtoPN fun==pn-                   =let  pat=pats!!nth   --get the nth formal parameter-                         pNames=hsPNs pat  --get all the names in this pat. (the pat may be just be a variable)-                    in if checking && not ( all (==False) ((map (flip findPN rhs) pNames)) && --not used in rhs-                                            all (==False) ((map (flip findPN decls) pNames))) --not used in the where clause-                         then error  "This parameter can not be removed, as it is used!"-                         else if updateToks-                                then  do  pats'<-delete pat pats-                                          return (HsMatch loc fun pats' rhs decls)-                                else return (HsMatch loc fun (pats\\[pat]) rhs decls)-                 rmInMatch _=mzero-----remove the nth argument of function pn in all the calling places. the index for the first argument is zero.-rmNthArgInFunCall pn nth updateToks=applyTP (stop_tdTP (failTP `adhocTP` funApp))-   where-         funApp (exp@(Exp (HsParen (Exp (HsApp e1 e2))))::HsExpP)-              |nth==0 && pn==expToPN e1-             =do if updateToks-                   then do update exp e1 exp    --handle the case like '(fun x) => fun "-                   else return e1-         funApp (exp@(Exp (HsApp e1 e2))::HsExpP)-              |pn==(expToPN.(ghead "rmNthArgInFunCall").unfoldHsApp) exp  --test if this application is a calling of fun pn.-               =do let (before,after)=splitAt (nth+1) (unfoldHsApp exp)   --remove the nth argument-                   if updateToks-                    then delete (ghead "rmNthArgInFunCall" after) exp-                    else return (foldHsApp (before++tail after))  --reconstruct the function application.--         funApp _=mzero--         --deconstruct a function application into a list of expressions.-         unfoldHsApp exp=-              case exp of-                  (Exp (HsApp e1 e2))->(unfoldHsApp e1)++[e2]-                  _ ->[exp]-         --reconstruct  a function application by a list of expressions.-         foldHsApp exps=foldl1 (\e1 e2->(Exp (HsApp e1 e2))) exps---rmNthArgInSig pn nth decls- = let (before,after)=break (\d ->definesTypeSig pn d) decls-   in if  after==[]-       then  return decls-       else  do newSig<-rmNthArgInSig' nth  [(head after)]  --no problem with 'head'-                return (before++newSig++(tail after))--   where rmNthArgInSig' nth sig@[(Dec (HsTypeSig loc is c tp))]-          =do let newSig=if length is ==1-                            then --this type signature only defines the type of pn-                                 [Dec (HsTypeSig loc is c (rmNth tp))]-                            else --this type signature also defines the type of other ids.-                                 [Dec (HsTypeSig loc (filter (\x->pNTtoPN x/=pn) is) c tp),-                                  Dec (HsTypeSig loc (filter (\x->pNTtoPN x==pn) is) c (rmNth tp))]-              update sig newSig sig--         rmNth tp=let (before,after)=splitAt nth (unfoldHsTypApp tp)-                    in  (foldHsTypApp (before ++ tail after))--         --deconstruct a type application into a list of types-         unfoldHsTypApp typ =-               case typ of (Typ (HsTyFun t1 t2)) ->t1:unfoldHsTypApp t2-                           _ ->[typ]--         --reconstruct a type application by a list of type expression.-         foldHsTypApp ts=foldr1 (\t1 t2->(Typ (HsTyFun t1 t2))) ts----get the function name and the index of the parameter to be removed from the cursor position.-getParam toks pos-     =(fromMaybe (defaultPNT, 0)).(applyTU (once_tdTU (failTU `adhocTU` inMatch)))-    where-       inMatch (match@(HsMatch loc  fun  pats rhs  decls)::HsMatchP)-          |inRange pos (getStartEndLoc toks pats)-          =let paramPosRanges=map (getStartEndLoc toks) pats-               elem=find (inRange pos) paramPosRanges-               in if isNothing elem-                    then error "Invalid cursor position!"  -- cursor doesn't stop at a parameter position.-                     else Just (fun, fromJust (elemIndex (fromJust elem) paramPosRanges))-       inMatch _=Nothing--       inRange pos (startPos,endPos)=pos>=startPos && pos<=endPos--rmParamInClientMod pnt nth (m, fileName)- = do (inscps, exps, mod, ts) <-parseSourceFile fileName-      let qualifier = hsQualifier pnt inscps-          pn = pNTtoPN pnt-      if  qualifier == []-          then return ((fileName,unmodified), (ts,mod))-          else do (mod',((ts',m), _)) <- runStateT (rmNthArgInFunCall pn nth True mod)-                                         ((ts,unmodified),(-1000,0))-                  return ((fileName,m), (ts',mod'))---}+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Haskell.Refact.Refactoring.AddRmParam+       ( addOneParameter, compAddOneParameter+       , rmOneParameter, compRmOneParameter+       ) where++import qualified Data.Generics as SYB+import qualified GHC.SYB.Utils as SYB++import qualified GHC+import qualified Name                  as GHC+import qualified Outputable            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 Language.Haskell.GHC.ExactPrint.Utils++import System.Directory+import Data.Char+import Data.Foldable+import Data.Maybe+import Data.List hiding (delete)++import Data.Generics.Strafunski.StrategyLib.StrategyLib++-----------------------------------------------------------------------------------------------------+{- 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 (compAddOneParameter absFileName paramName (row,col))++compAddOneParameter :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]+compAddOneParameter fileName paramName (row, col) = do+  if isVarId paramName+    then+      do+        parseSourceFileGhc fileName+        parsed  <- getRefactParsed+        nm      <- getRefactNameMap+        logParsedSource "compAdd entry"+        targetModule <- getRefactTargetModule+        logm $ "AddRmParam.compAdd:got targetModule"+        let maybePn = locToNameRdrPure nm (row, col) parsed+        case maybePn of+          Just 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 nm pn parsed+               then do+                  exported <- isExported pn+                  if exported+                    then do+                     clients <- clientModsAndFiles targetModule+                     decls <- liftT $ hsDecls parsed+                     let inscopes = []+                     defaultArg <- mkTopLevelDefaultArgName pn paramName inscopes decls+                     logm $ "compAdd:defaultArg=" ++ showGhc defaultArg+                     (refactoredMod,_) <- applyRefac (doAddingParam pn paramName (Just defaultArg) True) RSAlreadyLoaded+                     refactoredClients <- mapM (addArgInClientMod pn defaultArg) clients+                     -- let refactoredClients = []+                     return $ refactoredMod:refactoredClients+                    else do+                     logm $ "compAdd:not exported"+                     (refactoredMod,_) <- applyRefac (doAddingParam 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 ++ "!"+++-- ---------------------------------------------------------------------++doAddingParam :: GHC.Name -> String -> Maybe (GHC.Located GHC.RdrName) -> Bool+              -> RefactGhc ()+doAddingParam pn newParam defaultArg isExported' = do+    logm $ "doAddingParam entered:defaultArg=" ++ showGhc defaultArg+    parsed <- getRefactParsed+    -- logDataWithAnns "parsed" parsed+    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 :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource+             inMod modu = do+               nm <- getRefactNameMap+               decls <- liftT $ hsDecls modu+               if not ( null (definingDeclsRdrNames nm [pn] decls False False))+                then+                 do+                    logm $ "doAddingParam.inMod doing it"+                    ds <- liftT $ hsDecls modu+                    modu' <- doAdding modu ds+                    if isExported' && isExplicitlyExported nm pn modu+                      then addItemsToExport modu' (Just pn) False (Left [GHC.unLoc (fromJust defaultArg)])+                      else return modu'+                else mzero++             --2. pn is declared locally in the where clause of a match.+             inMatch ::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)+                     -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+             inMatch match+               = do+                   nm <- getRefactNameMap+                   decls <- liftT $ hsDecls match+                   logm $ "doAddingParam.inMatch:decls=" ++ showGhc decls+                   if not ( null (definingDeclsRdrNames nm [pn] decls False False))+                      then doAdding match decls+                      else 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@(GHC.L _ (GHC.HsLet _ds _e)) :: GHC.LHsExpr GHC.RdrName)+               = do+                   nm <- getRefactNameMap+                   decls <- liftT $ hsDecls letExp+                   -- logm $ "doAddingParam.inLet:decls=" ++ showGhc decls+                   if not ( null (definingDeclsRdrNames nm [pn] decls False False))+                      then doAdding letExp decls+                      else mzero+#if __GLASGOW_HASKELL__ <= 710+             inLet ((GHC.L l (GHC.HsDo ctx stmts ptt)) :: GHC.LHsExpr GHC.RdrName)+#else+             inLet ((GHC.L l (GHC.HsDo ctx (GHC.L ls stmts) ptt)) :: GHC.LHsExpr GHC.RdrName)+#endif+               = do+                   nm <- getRefactNameMap+                   -- logm $ "doAddingParam.inHsDo:stmts=" ++ showGhc stmts+                   if not ( null (definingDeclsRdrNames' nm [pn] stmts))+                      then do+                           stmts' <- doAddingStmts stmts+                           stmts2 <- applyTP (once_tdTP (failTP `adhocTP` inMod+                                                                `adhocTP` inMatch+                                                                -- `adhocTP` inPat+                                                                `adhocTP` inLet+                                                                -- `adhocTP` inHsDo+                                                                -- `adhocTP` inAlt+                                                               `adhocTP` inLetStmt+                                                         )+                                                        `choiceTP` failure) stmts'+#if __GLASGOW_HASKELL__ <= 710+                           return (GHC.L l (GHC.HsDo ctx stmts2 ptt))+#else+                           return (GHC.L l (GHC.HsDo ctx (GHC.L ls stmts2) ptt))+#endif+                      else mzero+             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@(GHC.L _ (GHC.LetStmt _stmts)):: GHC.ExprLStmt GHC.RdrName)+               = do+                   nm <- getRefactNameMap+                   decls <- liftT $ hsDecls letStmt+                   if not ( null (definingDeclsRdrNames nm [pn] decls False False))+                      then doAdding letStmt decls+                      else mzero+             inLetStmt _ = mzero++             failure = idTP `adhocTP` modu+               where modu (_::GHC.ParsedSource) = error "Refactoring failed"+++             doAdding :: (HasDecls t) => t -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc t+             doAdding parent ds = do+               nm <- getRefactNameMap+               if paramNameOk nm pn newParam ds+                   then do+                       ds' <- addParamsToDecls ds pn [mkRdrName newParam] --addFormalParam pn newParam ds+                       defaultParamPName <-if isNothing defaultArg+                                           then mkLocalDefaultArgName pn newParam parent+                                           else return (gfromJust "doAdding" defaultArg)+                       parent1 <- liftT $ replaceDecls parent ds'+                       parent' <- addDefaultActualArg False pn defaultParamPName parent1+                       parent''<- addDefaultActualArgDecl defaultParamPName parent' pn isExported'+                       ds2 <- liftT $ hsDecls parent''+                       ds'' <- addArgToSig pn ds2+                       parent3 <- liftT $ replaceDecls parent'' ds''+                       return parent3+                   else error " Refactoring failed."++             doAddingStmts :: [GHC.ExprLStmt GHC.RdrName] -> RefactGhc [GHC.ExprLStmt GHC.RdrName]+             doAddingStmts stmts = do+               logDataWithAnns "doAddingStmts:stmts:" stmts+               nm <- getRefactNameMap+               if paramNameOk nm pn newParam stmts+                   then do+                       defaultParamPName <-if isNothing defaultArg+                                           then mkLocalDefaultArgName pn newParam stmts+                                           else return (gfromJust "doAddingStmts" defaultArg)+                       stmts' <- addDefaultActualArg False pn defaultParamPName stmts+                       return stmts'+                   else error " Refactoring failed."++-- ---------------------------------------------------------------------++-- |check whether the new parameter is a legal.+paramNameOk :: (SYB.Data t) => NameMap -> GHC.Name -> String -> t -> Bool+paramNameOk nm pn newParam t+  = (fromMaybe True) (applyTU (once_tdTU (failTU `adhocTU` decl+                                                 `adhocTU` bind)) t)+  where+   decl :: GHC.LHsDecl GHC.RdrName -> Maybe Bool+   decl (GHC.L l (GHC.ValD d)) = bind (GHC.L l d)+   decl _ = mzero++   bind :: GHC.LHsBind GHC.RdrName -> Maybe Bool+#if __GLASGOW_HASKELL__ <= 710+   bind (GHC.L _ (GHC.FunBind n _i (GHC.MG matches _a _ptt _o) _co _fvs _))+#else+   bind (GHC.L _ (GHC.FunBind n (GHC.MG matches _a _ptt _o) _co _fvs _))+#endif+    | rdrName2NamePure nm n == pn+    = do results' <- mapM checkInMatch matches+         Just (all (==True) results')+   bind (GHC.L _ (GHC.PatBind _pat _rhs _ty _fvs _t))+      = error "Parameter can not be added to complex pattern binding"+   bind _ = mzero++   checkInMatch match+     = do let (f,d) = hsFDNamesFromInsideRdrPure nm match+          if elem newParam (f `union` d)+           then error "The new parameter name will cause name clash or semantics change, please choose another name!"+           else return True++-- ---------------------------------------------------------------------++-- |add the default argument declaration right after the declaration defining pn+addDefaultActualArgDecl :: (SYB.Data t) => GHC.Located GHC.RdrName -> t -> GHC.Name -> Bool -> RefactGhc t+addDefaultActualArgDecl defaultParamPName parent pn isExported' = do+  defaultArgDecl <- parseDeclWithAnns ((showGhc defaultParamPName) ++ " = undefined")+  nm <- getRefactNameMap+  let inParent = findLRdrName nm pn parent+  if not inParent && not isExported'+    then return parent+    else addDecl parent (Just pn) ([defaultArgDecl],Nothing)++-- ---------------------------------------------------------------------++-- |suppose function name is f, parameter name is p, then the default argument+-- name is like f_p.+mkLocalDefaultArgName :: (SYB.Data t)+                      => GHC.Name -> String -> t -> RefactGhc (GHC.Located GHC.RdrName)+mkLocalDefaultArgName fun paramName t = do+  logm $ "mkLocalDefaultArgName"+  (f,d) <- hsFDNamesFromInsideRdr t+  vs <- hsVisibleNamesRdr fun t -- ++AZ++ TODO : FindEntity on fun will fail in a RdrName AST+  let name = mkNewName ((showGhc fun)++"_"++paramName) (nub (f `union` d `union` vs)) 0+  loc <- liftT $ uniqueSrcSpanT+  let vn = (GHC.L loc (mkRdrName name))+  liftT $ addSimpleAnnT vn (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+  return vn++-- ---------------------------------------------------------------------++mkTopLevelDefaultArgName :: (SYB.Data t,GHC.Outputable a)+                         => a -> String -> [String] -> t+                         -> RefactGhc (GHC.Located GHC.RdrName)+mkTopLevelDefaultArgName fun paramName inscopeNames t = do+  (f,d) <- hsFDNamesFromInsideRdr t+  let name = mkNewName ((showGhc fun)++"_"++paramName) (nub (f `union` d `union` inscopeNames)) 0+  loc <- liftT $ uniqueSrcSpanT+  let vn = (GHC.L loc (mkRdrName name))+  liftT $ addSimpleAnnT vn (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+  return vn++-- ---------------------------------------------------------------------++-- |Add the default argument to each call site of the function receiving the new parameter (AZ)+addDefaultActualArg :: (SYB.Data t)+                    => Bool -- ^If True recursively add the parameter to all+                            -- occurences of the function call site. If False,+                            -- stop the recursion when hitting the function+                            -- itself.+                    -> GHC.Name -- ^ The function name to receive the new parameter+                    -> GHC.Located GHC.RdrName -- ^The new parameter name+                        -- ++AZ++: why is it located?+                    -> t -- ^The AST fragment to be updated+                    -> RefactGhc t+addDefaultActualArg recursion pn argPName t = do+  logm $ "addDefaultActualArg:(recursion,pn,argPName):" ++ showGhc (recursion,pn,argPName)+  logDataWithAnns "addDefaultActualArg:t=:" t+  nm <- getRefactNameMap+  if recursion then (applyTP (stop_tdTP (failTP `adhocTP` (funApp nm)))) t+               else (applyTP (stop_tdTP (failTP `adhocTP` (inDecl nm)+                                                `adhocTP` (funApp nm)))) t+       where+         inDecl :: NameMap -> GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+         inDecl nm fun@(GHC.L _ (GHC.ValD (GHC.FunBind n _i _ _co _fvs _)))+#else+         inDecl nm fun@(GHC.L _ (GHC.ValD (GHC.FunBind n _ _co _fvs _)))+#endif+           | rdrName2NamePure nm n == pn+           = return fun -- Stop the recursion by not returning mzero++         -- inDecl (pat@(Dec (HsPatBind loc1 ps rhs ds))::HsDeclP)+         --   | pn == patToPN  ps+         --   = return pat+         inDecl _ _ = mzero++         funApp :: NameMap -> GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+         funApp nm (expr@(GHC.L l (GHC.HsVar n))::GHC.LHsExpr GHC.RdrName)+#else+         funApp nm (expr@(GHC.L l (GHC.HsVar (GHC.L _ n)))::GHC.LHsExpr GHC.RdrName)+#endif+          | rdrName2NamePure nm (GHC.L l n) == pn = do+            logm $ "addDefaultActualArg.funApp:expr=" ++ showGhc expr+            addParamToExp expr (GHC.unLoc argPName)++         funApp _ _ = mzero+++-- ---------------------------------------------------------------------++-- | Add a parameter to a 'GHC.HsVar' expression+addParamToExp :: GHC.LHsExpr GHC.RdrName -> GHC.RdrName+              -> RefactGhc (GHC.LHsExpr GHC.RdrName)+addParamToExp (expr@(GHC.L _ (GHC.HsVar _))) argPName = do+  lp <- liftT uniqueSrcSpanT+  la <- liftT uniqueSrcSpanT+  lv <- liftT uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+  let e2 = GHC.L lv (GHC.HsVar argPName)+  liftT $ addSimpleAnnT e2  (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+#else+  let lname = GHC.L lv argPName+  let e2 = GHC.L lv (GHC.HsVar lname)+  liftT $ addSimpleAnnT e2 (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+#endif+  let ret = GHC.L lp (GHC.HsPar (GHC.L la (GHC.HsApp expr e2)))+  liftT $ addSimpleAnnT ret (DP (0,0)) [((G GHC.AnnOpenP),DP (0,0)),((G GHC.AnnCloseP),DP (0,0))]+  liftT $ transferEntryDPT expr ret+  liftT $ setEntryDPT expr (DP (0,0))+  return ret+addParamToExp x _+  = error $ "AddRmParam.addParamToExp: can only add param to HsVar, got:" ++ showGhc x++-- ---------------------------------------------------------------------++-- |Add type arg to type siginature+addArgToSig :: GHC.Name -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+addArgToSig pn decls = do+   nm <- getRefactNameMap+   let (before,after) = break (\d -> definesSigDRdr nm pn d) decls+     in if  null after+       then  return decls+       else  do newSig<-addArgToSig' [(head after)]  --no problem with head.+                return (before++newSig++(tail after))++    where+       addArgToSig' :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+       addArgToSig' sig@[(GHC.L l (GHC.SigD (GHC.TypeSig is tp pr)))] = do+#else+       addArgToSig' sig@[(GHC.L l (GHC.SigD (GHC.TypeSig is typ@(GHC.HsIB ivs (GHC.HsWC wcs mwc tp)))))] = do+#endif+              nm <- getRefactNameMap+              let tVar = mkNewTypeVarName sig+#if __GLASGOW_HASKELL__ <= 710+              typeVar <- newTypeVar tVar tp+#else+              typeVar' <- newTypeVar tVar tp+              let typeVar = GHC.HsIB ivs (GHC.HsWC wcs mwc typeVar')+#endif+              let newSig=if length is==1+#if __GLASGOW_HASKELL__ <= 710+                           then  --the type sig only defines the type for pn+                                [GHC.L l (GHC.SigD (GHC.TypeSig is typeVar pr))]+                           else  --otherwise, seperate it into two type signatures.+                               [GHC.L l (GHC.SigD (GHC.TypeSig (filter (\x->rdrName2NamePure nm x/=pn) is) tp pr)),+                                GHC.L l (GHC.SigD (GHC.TypeSig (filter (\x->rdrName2NamePure nm x==pn) is) typeVar pr))]+#else+                           then  --the type sig only defines the type for pn+                                [GHC.L l (GHC.SigD (GHC.TypeSig is typeVar))]+                           else  --otherwise, seperate it into two type signatures.+                               [GHC.L l (GHC.SigD (GHC.TypeSig (filter (\x->rdrName2NamePure nm x/=pn) is) typ)),+                                GHC.L l (GHC.SigD (GHC.TypeSig (filter (\x->rdrName2NamePure nm x==pn) is) typeVar))]+#endif+              return newSig+       addArgToSig' sig = do+         logm $ "addArgToSig':not processing " ++ showGhc sig+         return sig+++       -- compose a type application using type expressions tv and tp+       newTypeVar :: String -> GHC.LHsType GHC.RdrName -> RefactGhc (GHC.LHsType GHC.RdrName)+       newTypeVar tVar tp = do+         ls <- liftT $ uniqueSrcSpanT+         lv <- liftT $ uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+         let tv = GHC.L lv (GHC.HsTyVar (mkRdrName tVar))+         liftT $ addSimpleAnnT tv  (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+#else+         let lname = GHC.L lv (mkRdrName tVar)+         let tv = GHC.L lv (GHC.HsTyVar lname)+         liftT $ addSimpleAnnT lname  (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+#endif+         let typ = GHC.L ls (GHC.HsFunTy tv tp)+         liftT $ addSimpleAnnT typ (DP (0,1)) [((G GHC.AnnRarrow),DP (0,1))]+         return typ++       -- make a fresh type variable name. the new name is the first letter in+       -- the alphabet which is not used in the type signature.+       mkNewTypeVarName :: [GHC.LHsDecl GHC.RdrName] -> String+       mkNewTypeVarName sig+          =mkANewName "a" $ map showGhc $ (snd.hsTypeVbls) sig+             where mkANewName initName v+                     =if elem initName v+                         then mkANewName ((intToDigit (digitToInt(head initName)+1)):tail initName) v+                         else initName++-- ---------------------------------------------------------------------++addArgInClientMod :: GHC.Name -> GHC.Located GHC.RdrName -> TargetModule -> RefactGhc ApplyRefacResult+addArgInClientMod pnt defaultArg serverModName = do+  (r,_) <- applyRefac (addArgInClientMod' pnt defaultArg (GM.mpModule serverModName)) (RSTarget serverModName)+  return r+++addArgInClientMod' :: GHC.Name -> GHC.Located GHC.RdrName -> GHC.ModuleName -> RefactGhc ()+addArgInClientMod' pnt defaultArg serverModName = do+   parsed <- getRefactParsed+   let pn = pnt+   qual <- hsQualifier pnt+   if qual == []+          then return ()+          else do+            mod'  <- addItemsToImport serverModName  (Just pn) (Left [GHC.unLoc defaultArg]) parsed+            mod'' <- addItemsToExport mod' (Just pn) False (Left [GHC.unLoc defaultArg])+            mod3 <- addDefaultActualArgInClientMod pn defaultArg mod''+            putRefactParsed mod3 emptyAnns+            return ()+++-- ---------------------------------------------------------------------++-- |Add default actual argument to pn in all the calling places.+addDefaultActualArgInClientMod :: (SYB.Data t)+  => GHC.Name -> GHC.Located GHC.RdrName -> t+  -> RefactGhc t+addDefaultActualArgInClientMod pn argPName t = do+  logm $ "addDefaultActualArgInClientMod entered:argPName=" ++ showGhc argPName+  nm <- getRefactNameMap+  r <- applyTP (stop_tdTP (failTP `adhocTP` (funApp nm))) t+  return r+  where+#if __GLASGOW_HASKELL__ <= 710+    funApp nm (expr@((GHC.L l (GHC.HsVar pname )))::GHC.LHsExpr GHC.RdrName)+#else+    funApp nm (expr@((GHC.L l (GHC.HsVar (GHC.L _ pname) )))::GHC.LHsExpr GHC.RdrName)+#endif+      | GHC.nameUnique (rdrName2NamePure nm (GHC.L l pname)) == GHC.nameUnique pn+       = do+            logm $ "addDefaultActualArgInClientMod:hit"+            -- vs <- hsVisibleNamesRdr (GHC.L l pname) t+            let argExp = GHC.unLoc argPName+            addParamToExp expr argExp+    funApp _ _ = mzero++-------------------------------End of adding a parameter-----------------------------------++-----------------------------------------------------------------------------------------------------+{-Refactoring: Remove a parameter+  Description: The refactoring removes a user specified formal parameter in a function binding,and+               the corresponding actual parameters in all calling places of this function. The+               condition acompanying this refactoring is that the parameter to be removed is not being used.++  --To select a parameter, just stop the cursor at any position between the start and end position of this parameter.+-}+-----------------------------------------------------------------------------------------------------++-- |The refactoring removes a user specified formal parameter in a function+-- binding,and the corresponding actual parameters in all calling places of this+-- function. The condition acompanying this refactoring is that the parameter to+-- be removed is not being used.+-- The @SimpPos@ should be somwewhere inside the parameter to be removed+rmOneParameter :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]+rmOneParameter settings opts fileName (row,col) = do+  absFileName <- canonicalizePath fileName+  runRefacSession settings opts (compRmOneParameter absFileName (row,col))++compRmOneParameter :: FilePath -> SimpPos -> RefactGhc [ApplyRefacResult]+compRmOneParameter fileName (row, col) = do+  parseSourceFileGhc fileName+  -- logParsedSource "compRm entry"+  -- pn is the function names.+  -- nth is the nth paramter of pn is to be removed,index starts from 0.+  mp <- getParam (row,col)+  case mp of+    Nothing -> error "Invalid cursor position!"  -- cursor doesn't stop at a parameter position.+    Just (pn,pnth) -> do+      logm $ "compRm:(pn,pnth)=" ++ showGhc (pn,pnth)+      exported <- isExported pn+      if exported+        then do+          logm $ "compRm: exported"+          (refactoredMod,_) <- applyRefac (doRmParam pn pnth) (RSFile fileName)+          targetModule <- getRefactTargetModule+          clients <- clientModsAndFiles targetModule+          logm $ "compRm: clients:" ++ showGhc clients+          refactoredClients <- mapM (rmParamInClientMod pn pnth) clients+          -- let refactoredClients = []+          return $ refactoredMod:refactoredClients+        else do+          logm $ "compRm:not exported"+          (refactoredMod,_) <- applyRefac (doRmParam pn pnth) (RSFile fileName)+          return [refactoredMod]+++-- ---------------------------------------------------------------------++--pn: function name; nth: the index of the parameter to be removed.+doRmParam :: GHC.Name -> Int -> RefactGhc ()+doRmParam pn nTh = do+    logm $ "doRmParam entered:(pn,nth)=" ++ showGhc (pn,nTh)+    parsed <- getRefactParsed+    r <- applyTP ((once_tdTP (failTP `adhocTP` inMod+                                     `adhocTP` inMatch+                                     -- `adhocTP` inPat+                                     `adhocTP` inLet+                                     -- `adhocTP` inAlt+                                     `adhocTP` inLetStmt+                             ))+                  `choiceTP` failure) parsed+    logm $ "doRmParam after applyTP"+    putRefactParsed r emptyAnns+    logParsedSource "doRmParam:parsed after"+    return ()+      where+             --1. pn is declared in top level.+             inMod :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource+             inMod modu = doRemoving' modu++             -- --2. pn is declared locally in the where clause of a match.+             inMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+#if __GLASGOW_HASKELL__ <= 710+             inMatch match@(GHC.L _ (GHC.Match (Just (_fun,_)) _pats _mtyp (GHC.GRHSs _rhs _ds)))+#else+             inMatch match@(GHC.L _ (GHC.Match (GHC.FunBindMatch _fun _) _pats _mtyp (GHC.GRHSs _rhs _ds)))+#endif+               = doRemoving' match+             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/=[]  = doRemoving pat  ds+             -- inPat _=mzero++             -- --4: pn is declared locally in a  Let expression+             inLet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+             inLet letExp@(GHC.L _ (GHC.HsLet _bs _e))+               = doRemoving' letExp+#if __GLASGOW_HASKELL__ <= 710+             inLet (GHC.L l (GHC.HsDo ctx stmts ptt))+#else+             inLet (GHC.L l (GHC.HsDo ctx (GHC.L ls stmts) ptt))+#endif+               = do+                   nm <- getRefactNameMap+                   if not ( null (definingDeclsRdrNames' nm [pn] stmts))+                      then do+                           stmts' <- doRemovingStmts stmts+#if __GLASGOW_HASKELL__ <= 710+                           return (GHC.L l (GHC.HsDo ctx stmts' ptt))+#else+                           return (GHC.L l (GHC.HsDo ctx (GHC.L ls stmts') ptt))+#endif+                      else mzero+             inLet _ = mzero++             -- --5. pn is declared locally in a  case alternative.+             -- inAlt (alt@(HsAlt loc p rhs ds)::HsAltP)+             --    | definingDecls [pn] ds False  False/=[]  = doRemoving  alt  ds+             -- inAlt _=mzero++             -- --6.pn is declared locally in a let statement.+             inLetStmt :: GHC.ExprLStmt GHC.RdrName -> RefactGhc (GHC.ExprLStmt GHC.RdrName)+             inLetStmt letStmt@(GHC.L _ (GHC.LetStmt _))+               = doRemoving' letStmt+             inLetStmt _ = mzero++             failure = idTP `adhocTP` modu+               where modu (_m::GHC.ParsedSource) = error "Refactoring failed"++             -- ------------------------++             doRemoving' parent = do+               nm <- getRefactNameMap+               decls <- liftT $ hsDecls parent+               if not ( null (definingDeclsRdrNames nm [pn] decls False False))+                  then doRemoving parent decls+                  else mzero++             doRemoving :: (HasDecls t) => t -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc t+             doRemoving parent ds  --PROBLEM: How about doRemoving fails?+                =do+                    -- Check the preconditions, will error on failure+                    void $ rmFormalArg pn nTh False True =<< rmNthArgInFunCall pn nTh ds++                    -- preconditions passed, do the transformation+                    ds' <- rmNthArgInSig pn nTh   =<< rmFormalArg pn nTh True False  ds+                    ds'' <- liftT $ replaceDecls parent ds'+                    rmNthArgInFunCall pn nTh ds''++             doRemovingStmts :: [GHC.ExprLStmt GHC.RdrName] -> RefactGhc [GHC.ExprLStmt GHC.RdrName]+             doRemovingStmts stmts+                =do+                    -- Check the preconditions, will error on failure+                    void $ rmFormalArg pn nTh False True =<< rmNthArgInFunCall pn nTh stmts++                    -- preconditions passed, do the transformation+                    stmts' <- rmFormalArg pn nTh True False stmts+                    rmNthArgInFunCall pn nTh stmts'++             -- |Just remove the nth formal parameter.+             rmFormalArg :: (SYB.Data t) => GHC.Name -> Int -> Bool -> Bool -> t -> RefactGhc t+             rmFormalArg pn' nTh' updateToks checking t = do+               logm $ "rmFormalArg:(pn,nTh,updateToks,checking)=" ++ showGhc (pn',nTh',updateToks,checking)+               -- logDataWithAnns "rmFormalArg:t=" t+               nm <- getRefactNameMap+               applyTP (stop_tdTP (failTP `adhocTP` (rmInMatch nm))) t++               where+                 -- a formal parameter only exists in a match+#if __GLASGOW_HASKELL__ <= 710+                 rmInMatch nm (match@(GHC.L l (GHC.Match (Just (fun,b)) pats typ (GHC.GRHSs rhs decls)))::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+#else+                 rmInMatch nm (match@(GHC.L l (GHC.Match (GHC.FunBindMatch fun b) pats typ (GHC.GRHSs rhs decls)))::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+#endif+                   | rdrName2NamePure nm fun == pn' =+                       let  pat = pats!!nTh'     --get the nth formal parameter+                            pats' = take nTh' pats ++ drop (nTh' + 1) pats+                            pNames = map (rdrName2NamePure nm) $ hsNamessRdr pat  --get all the names in this pat. (the pat may be just be a variable)+                       in if checking && not ( all (==False) ((map (flip (findNameInRdr nm) rhs) pNames)) && --not used in rhs+                                               all (==False) ((map (flip (findNameInRdr nm) decls) pNames))) --not used in the where clause+                            then error  "This parameter can not be removed, as it is used!"+                            else do+                              -- If we have removed the last parametwer, make+                              -- sure the AnnEqual annotation takes its spacing+                              -- from the original parameter spacing+                              when (null pats') $ do+                                dp <- liftT $ getEntryDPT (ghead "rmFormalArg" pats)+                                logm $ "rmFormalArg.rmInMatch:dp=" ++ show dp+                                liftT $ setAnnKeywordDP match (G GHC.AnnEqual) dp+#if __GLASGOW_HASKELL__ <= 710+                              return (GHC.L l (GHC.Match (Just (fun,b)) pats' typ (GHC.GRHSs rhs decls)))+#else+                              return (GHC.L l (GHC.Match (GHC.FunBindMatch fun b) pats' typ (GHC.GRHSs rhs decls)))+#endif+                 rmInMatch _ _ = mzero++-- ---------------------------------------------------------------------++-- |Remove the nth argument of function pn in all the calling places. The index+-- for the first argument is zero.+rmNthArgInFunCall :: (SYB.Data t) => GHC.Name -> Int -> t -> RefactGhc t+rmNthArgInFunCall pn nTh t = do+  nm <- getRefactNameMap+  applyTP (stop_tdTP (failTP `adhocTP` (funApp nm))) t+   where+         funApp nm (expr@(GHC.L _ (GHC.HsPar (GHC.L _ (GHC.HsApp e1 _e2))))::GHC.LHsExpr GHC.RdrName)+              | nTh == 0 && Just pn == expToNameRdr nm e1+             = do+                 liftT $ transferEntryDPT expr e1+                 return e1 -- handle the case like '(fun x) => fun "+         funApp nm (expr@(GHC.L _ (GHC.HsApp _e1 _e2))) = do+                --test if this application is a calling of fun pn.+              let expu = unfoldHsApp expr+              ed <- liftT $ getEntryDPT expr+              if Just pn == (expToNameRdr nm.snd.(ghead "rmNthArgInFunCall")) expu+               then do+                  let (before,after)=splitAt (nTh+1) expu   --remove the nth argument+                  let exp' = (foldHsApp (before++tail after))  --reconstruct the function application.+                  liftT $ setEntryDPT exp' ed+                  return exp'+               else mzero++         funApp _ _ = mzero++         -- |deconstruct a function application into a list of expressions.+         unfoldHsApp :: GHC.LHsExpr GHC.RdrName -> [(GHC.SrcSpan, GHC.LHsExpr GHC.RdrName)]+         unfoldHsApp expr =+              case expr of+                  (GHC.L l (GHC.HsApp e1 e2)) -> unfoldHsApp e1 ++ [(l,e2)]+                  _                           -> [(GHC.noSrcSpan,expr)]++         -- |reconstruct  a function application by a list of expressions.+         foldHsApp :: [(GHC.SrcSpan, GHC.LHsExpr GHC.RdrName)] -> GHC.LHsExpr GHC.RdrName+         foldHsApp [] = error "foldHsApp:empty list"+         foldHsApp exps = snd $ foldl1 (\(_l1,e1) (l2,e2) -> (l2,GHC.L l2 (GHC.HsApp e1 e2))) exps+++-- ---------------------------------------------------------------------++rmNthArgInSig :: GHC.Name -> Int -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+rmNthArgInSig pn nTh decls = do+  nm <- getRefactNameMap+  let (before,after)=break (\d ->definesSigDRdr nm pn d) decls+  if null after+       then  return decls+       else  do newSig<-rmNthArgInSig' nm [(head after)]  --no problem with 'head'+                return (before++newSig++(tail after))++   where+#if __GLASGOW_HASKELL__ <= 710+         rmNthArgInSig' nm [GHC.L l (GHC.SigD (GHC.TypeSig is typ@(GHC.L lt (GHC.HsForAllTy ex wc bnd ctx tp)) c))]+#else+         -- rmNthArgInSig' nm [GHC.L l (GHC.SigD (GHC.TypeSig is typ@(GHC.HsIB ivs (GHC.HsWC wcs mwc (GHC.L lt (GHC.HsForAllTy bnd tp))))))]+         rmNthArgInSig' nm [GHC.L l (GHC.SigD (GHC.TypeSig is typ@(GHC.HsIB ivs (GHC.HsWC wcs mwc tp))))]+#endif+          =do+              ed <- liftT $ getEntryDPT tp+              let (GHC.L lp tp') = rmNth tp+              lp' <- liftT uniqueSrcSpanT+              liftT $ modifyAnnsT $ copyAnn (GHC.L lp tp') (GHC.L lp' tp')+              liftT $ setEntryDPT (GHC.L lp' tp') ed+#if __GLASGOW_HASKELL__ <= 710+              let typ' = GHC.L lt (GHC.HsForAllTy ex wc bnd ctx (GHC.L lp' tp'))+#else+              -- let typ' = GHC.HsIB ivs (GHC.HsWC wcs mwc (GHC.L lt (GHC.HsForAllTy bnd (GHC.L lp' tp'))))+              let typ' = GHC.HsIB ivs (GHC.HsWC wcs mwc (GHC.L lp' tp'))+#endif+              newSig <- liftT $ if length is ==1+                then --this type signature only defines the type of pn+#if __GLASGOW_HASKELL__ <= 710+                     return [GHC.L l (GHC.SigD (GHC.TypeSig is typ' c))]+#else+                     return [GHC.L l (GHC.SigD (GHC.TypeSig is typ'))]+#endif+                else do --this type signature also defines the type of other ids.+                     let otherNames = filter (\x->rdrName2NamePure nm x/=pn) is+                         [thisName] = filter (\x->rdrName2NamePure nm x==pn) is+                     removeTrailingCommaT thisName+                     removeTrailingCommaT (last otherNames)+                     ls <- uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+                     let otherSig = GHC.L l  (GHC.SigD (GHC.TypeSig otherNames typ  c))+                         thisSig  = GHC.L ls (GHC.SigD (GHC.TypeSig [thisName] typ' c))+#else+                     let otherSig = GHC.L l  (GHC.SigD (GHC.TypeSig otherNames typ))+                         thisSig  = GHC.L ls (GHC.SigD (GHC.TypeSig [thisName] typ'))+#endif+                     modifyAnnsT $ copyAnn otherSig thisSig+                     clearPriorComments thisSig+                     setEntryDPT thisSig (DP (2,0))+                     return [otherSig,thisSig]+              return newSig+         rmNthArgInSig' _nm sig = return sig++         rmNth tp = let (before,after)=splitAt nTh (unfoldHsTypApp tp)+                    in  (foldHsTypApp (before ++ tail after))++         --deconstruct a type application into a list of types+         unfoldHsTypApp :: GHC.LHsType GHC.RdrName -> [(GHC.SrcSpan,GHC.LHsType GHC.RdrName)]+         unfoldHsTypApp typ =+               case typ of (GHC.L l (GHC.HsFunTy t1 t2)) ->(l,t1):unfoldHsTypApp t2+                           _ ->[(GHC.noSrcSpan,typ)]++         --reconstruct a type application by a list of type expression.+         foldHsTypApp :: [(GHC.SrcSpan,GHC.LHsType GHC.RdrName)] -> GHC.LHsType GHC.RdrName+         foldHsTypApp [] = error "foldHsTypApp:empty list"+         foldHsTypApp ts=snd $ foldr1 (\(l1,t1) (_l2,t2)->(l1,GHC.L l1 (GHC.HsFunTy t1 t2))) ts++-- ---------------------------------------------------------------------++-- |Get the function name and the index of the parameter to be removed from the+-- cursor position.+getParam :: SimpPos -> RefactGhc (Maybe (GHC.Name,Int))+getParam pos = do+  nm <- getRefactNameMap+  parsed <- getRefactParsed+  let r = applyTU (once_tdTU (failTU `adhocTU` inMatch)) parsed+  case r of+    Nothing     -> return Nothing+    Just (ln,i) -> return $ Just (rdrName2NamePure nm ln,i)+    where+#if __GLASGOW_HASKELL__ <= 710+       inMatch ((GHC.Match (Just (fun,_)) pats _mtyp _grhs)::GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))+#else+       inMatch ((GHC.Match (GHC.FunBindMatch fun _) pats _mtyp _grhs)::GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))+#endif+         = case locToRdrName pos pats of+             Nothing  -> Nothing+             Just _ln -> if isNothing element+                    then error  "Invalid cursor position!"  -- cursor doesn't stop at a parameter position.+                    else Just (fun, fromJust (elemIndex (fromJust element) paramPosRanges))+               where+                 paramPosRanges = map GHC.getLoc pats+                 element = find (inRange pos) paramPosRanges+       inMatch _ = Nothing++       inRange pos' ss = pos' >= startPos && pos'<=endPos+         where (startPos,endPos) = (ss2pos ss,ss2posEnd ss)++-- ---------------------------------------------------------------------++rmParamInClientMod :: GHC.Name -> Int -> TargetModule -> RefactGhc ApplyRefacResult+rmParamInClientMod pn nTh serverModName = do+  logm $ "rmParamInClientMod:serverModName" ++ showGhc serverModName+  (r,_) <- applyRefac (rmNthArgInFunCallMod pn nTh) (RSTarget serverModName)+  return r++rmNthArgInFunCallMod :: GHC.Name -> Int -> RefactGhc ()+rmNthArgInFunCallMod pn nTh = do+  parsed <- getRefactParsed+  newNames <- equivalentNameInNewMod pn+  logm $ "rmNthArgInFunCallMod:(newNames)=" ++ showGhcQual newNames+  case newNames of+    [] -> return ()+    [_pnt] -> do+      parsed' <- rmNthArgInFunCall pn nTh parsed+      putRefactParsed parsed' emptyAnns+      return ()+    _ns   -> error "HaRe: rmParam: more than one name matches"+

src/Language/Haskell/Refact/Refactoring/Case.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE StandaloneDeriving #-} module Language.Haskell.Refact.Refactoring.Case   ( ifToCase@@ -82,13 +83,26 @@   falseLoc       <- liftT uniqueSrcSpanT -- HaRe:-1:7   falseMatchLoc  <- liftT uniqueSrcSpanT -- HaRe:-1:8   falseRhsLoc    <- liftT uniqueSrcSpanT -- HaRe:-1:9+#if __GLASGOW_HASKELL__ > 710+  matchesLoc     <- liftT uniqueSrcSpanT -- HaRe:-1:10+  lbTrueLoc      <- liftT uniqueSrcSpanT -- HaRe:-1:11+  lbFalseLoc     <- liftT uniqueSrcSpanT -- HaRe:-1:11+#endif   let trueName  = mkRdrName "True"   let falseName = mkRdrName "False"   let ret = GHC.L caseLoc (GHC.HsCase e1              (GHC.MG+              (+#if __GLASGOW_HASKELL__ > 710+              GHC.L matchesLoc+#endif               [                 (GHC.L trueMatchLoc $ GHC.Match+#if __GLASGOW_HASKELL__ <= 710                  Nothing+#else+                 GHC.NonFunBindMatch+#endif                  [                    GHC.L trueLoc1 $ GHC.ConPatIn (GHC.L trueLoc trueName) (GHC.PrefixCon [])                  ]@@ -96,10 +110,19 @@                  (GHC.GRHSs                    [                      GHC.L trueRhsLoc $ GHC.GRHS [] e2-                   ] GHC.EmptyLocalBinds)+                   ]+                   (+#if __GLASGOW_HASKELL__ > 710+                    GHC.L lbTrueLoc+#endif+                   GHC.EmptyLocalBinds))                 )               , (GHC.L falseMatchLoc $ GHC.Match-                 Nothing+#if __GLASGOW_HASKELL__ <= 710+                  Nothing+#else+                  GHC.NonFunBindMatch+#endif                  [                    GHC.L falseLoc1 $ GHC.ConPatIn (GHC.L falseLoc falseName) (GHC.PrefixCon [])                  ]@@ -107,9 +130,14 @@                  (GHC.GRHSs                    [                      GHC.L falseRhsLoc $ GHC.GRHS [] e3-                   ] GHC.EmptyLocalBinds)+                   ]+                   (+#if __GLASGOW_HASKELL__ > 710+                   GHC.L lbFalseLoc+#endif+                   GHC.EmptyLocalBinds))                 )-              ] [] GHC.placeHolderType GHC.FromSource))+              ]) [] GHC.placeHolderType GHC.FromSource))    oldAnns <- liftT $ getAnnsT   let annIf   = gfromJust "Case.annIf"   $ getAnnotationEP li oldAnns

src/Language/Haskell/Refact/Refactoring/DupDef.hs view

@@ -42,14 +42,17 @@         parseSourceFileGhc fileName         renamed <- getRefactRenamed         parsed  <- getRefactParsed+        nm <- getRefactNameMap         targetModule <- getRefactTargetModule         logm $ "DupDef.compDuplicateDef:got targetModule"          let (Just (modName,_)) = getModuleName parsed-        let maybePn = locToName (row, col) renamed+        let maybePn = locToRdrName (row,col) parsed+        -- let maybePn = locToNameRdrPure nm (row, col) parsed         case maybePn of-          Just pn ->+          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@@ -171,7 +174,7 @@         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+          -- logm $ "doDuplicating'':parentr=" ++ SYB.showData SYB.Parser 0 parentr           r <- hasDeclsSybTransform workerHsDecls workerBind parentr           logm $ "doDuplicating'':done"           return r@@ -208,13 +211,13 @@                     --d: names that might clash with the new name                  logm $ "doDuplicating'':(f,d)=" ++ show (f,d)-                dv <- hsVisiblePNsRdr nm ln declsp --dv: names may shadow new name+                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 && findEntity ln duplicatedDecls)+                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@@ -233,17 +236,17 @@ refactorInClientMod oldPN serverModName newPName targetModule   = do        logm ("refactorInClientMod: (oldPN,serverModName,newPName)=" ++ (showGhc (oldPN,serverModName,newPName)))-       -- void $ activateModule targetModule        getTargetGhc targetModule         let fileName = GM.mpPath targetModule        renamed <- getRefactRenamed-       parsed <- getRefactParsed+       parsed  <- getRefactParsed +       logm $ "refactorInClientMod:got newPName:" ++ showGhcQual newPName        let modNames = willBeUnQualImportedBy serverModName renamed        logm ("refactorInClientMod: (modNames)=" ++ (showGhc (modNames))) -- ++AZ++ debug -       mustHide <- needToBeHided newPName renamed parsed+       mustHide <- needToBeHided newPName parsed        logm ("refactorInClientMod: (mustHide)=" ++ (showGhc (mustHide))) -- ++AZ++ debug        if isJust modNames && mustHide         then do@@ -251,11 +254,15 @@                 return refactoredMod         else return ((fileName,RefacUnmodifed),(emptyAnns,parsed))    where-     needToBeHided :: GHC.Name -> GHC.RenamedSource -> GHC.ParsedSource -> RefactGhc Bool-     needToBeHided name exps parsed = do+     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 oldPN name serverModName exps+         return $ usedUnqual || causeNameClashInExports nm oldPN name serverModName parsed  doDuplicatingClient :: GHC.ModuleName -> [GHC.Name]               -> RefactGhc ()

src/Language/Haskell/Refact/Refactoring/MoveDef.hs view

@@ -16,17 +16,14 @@  import qualified Data.Generics as SYB import qualified GHC.SYB.Utils as SYB+ import qualified Data.Generics.Zipper as Z   import qualified Exception             as GHC-import qualified FastString            as GHC import qualified GHC                   as GHC import qualified Name                  as GHC import qualified RdrName               as GHC-import qualified TyCon                 as GHC-import qualified TypeRep               as GHC-import qualified Var                   as Var  import Control.Exception import Control.Monad.State@@ -93,13 +90,13 @@      -> RefactGhc [ApplyRefacResult] compLiftToTopLevel fileName (row,col) = do       parseSourceFileGhc fileName-      renamed <- getRefactRenamed       parsed  <- getRefactParsed+      nm <- getRefactNameMap        let (Just (modName,_)) = getModuleName parsed-      let maybePn = locToName (row, col) renamed+      let maybePn = locToRdrName (row, col) parsed       case maybePn of-        Just pn -> liftToTopLevel' modName pn+        Just ln@(GHC.L l _) -> liftToTopLevel' modName (GHC.L l (rdrName2NamePure nm ln))         _       -> error "\nInvalid cursor position!\n"  @@ -139,9 +136,11 @@                 -> RefactGhc [ApplyRefacResult] liftToTopLevel' modName pn@(GHC.L _ n) = do   renamed <- getRefactRenamed+  parsed  <- getRefactParsed+  nm      <- getRefactNameMap   targetModule <- getRefactTargetModule   logm $ "liftToTopLevel':pn=" ++ (showGhc pn)-  if isLocalFunOrPatName n renamed+  if isLocalFunOrPatName nm n parsed       then do               (refactoredMod,declPns) <- applyRefac liftToMod RSAlreadyLoaded @@ -156,19 +155,22 @@       else error "\nThe identifier is not a local function/pattern name!"      where-       {-step1: divide the module's top level declaration list into three parts:-         'parent' is the top level declaration containing the lifted declaration,-         'before' and `after` are those declarations before and after 'parent'.+       {-step1: divide the module's top level declaration list into three parts: 'parent'+                is the top level declaration containing the lifted declaration, 'before'+                and `after` are those declarations before and after 'parent'.          step2: get the declarations to be lifted from parent, bind it to liftedDecls-         step3: remove the lifted declarations from parent and extra arguments may be introduce.+         step3: remove the lifted declarations from parent and extra arguments+                may be introduced.          step4. test whether there are any names need to be renamed.        -}        liftToMod = do-         renamed <- getRefactRenamed-         parsed <- getRefactParsed+         parsed' <- getRefactParsed+         parsed  <- liftT $ balanceAllComments parsed'+         nm      <- getRefactNameMap+         logDataWithAnns "parsed after balanceAllComments" parsed          declsp <- liftT $ hsDecls parsed          (before,parent,after) <- divideDecls declsp pn-         {- ++AZ++ : hsBinds does not return class or instance definitions+         {- ++AZ++TODO: reinstate this, hsDecls does : hsBinds does not return class or instance definitions          when (isClassDecl $ ghead "liftToMod" parent)                $ error "Sorry, the refactorer cannot lift a definition from a class declaration!"          when (isInstDecl $ ghead "liftToMod" parent)@@ -188,7 +190,8 @@          pns <- pnsNeedRenaming parsed parent liftedDecls declaredPns          logm $ "liftToMod:(pns needing renaming)=" ++ (showGhc pns) -         let dd = getDeclaredVars $ hsBinds renamed+         decls <- liftT $ hsDecls parsed'+         let dd = getDeclaredVarsRdr nm decls          logm $ "liftToMod:(ddd)=" ++ (showGhc dd)           if pns == []@@ -196,8 +199,8 @@              (parent',liftedDecls',mLiftedSigs') <- addParamsToParentAndLiftedDecl n dd parent liftedDecls mLiftedSigs               let defName  = (ghead "liftToMod" (definedNamesRdr nameMap (ghead "liftToMod2" parent')))-             parsed' <- liftT $ replaceDecls parsed (before++parent'++after)-             parsed2 <- moveDecl1 parsed' (Just defName) [GHC.unLoc pn] liftedDecls'+             parsed1 <- liftT $ replaceDecls parsed (before++parent'++after)+             parsed2 <- moveDecl1 parsed1 (Just defName) [GHC.unLoc pn] liftedDecls'                                                             declaredPns mLiftedSigs'              putRefactParsed parsed2 emptyAnns @@ -219,14 +222,14 @@      -> RefactGhc [ApplyRefacResult] compLiftOneLevel fileName (row,col) = do       parseSourceFileGhc fileName-      renamed <- getRefactRenamed       parsed  <- getRefactParsed+      nm <- getRefactNameMap        let (Just (modName,_)) = getModuleName parsed-      let maybePn = locToName (row, col) renamed+      let maybePn = locToRdrName (row, col) parsed       case maybePn of-        Just pn ->  do-            rs <- liftOneLevel' modName pn+        Just ln@(GHC.L l _) ->  do+            rs <- liftOneLevel' modName (GHC.L l (rdrName2NamePure nm ln))             logm $ "compLiftOneLevel:rs=" ++ (show $ (refactDone rs,map (\((_,d),_) -> d) rs))             if (refactDone rs)               then return rs@@ -319,8 +322,10 @@  liftOneLevel' modName pn@(GHC.L _ n) = do   renamed <- getRefactRenamed+  parsed  <- getRefactParsed+  nm      <- getRefactNameMap   targetModule <- getRefactTargetModule-  if isLocalFunOrPatName n renamed+  if isLocalFunOrPatName nm n parsed         then do                 (refactoredMod,(b,pns)) <- applyRefac doLiftOneLevel RSAlreadyLoaded                 logm $ "liftOneLevel':main refactoring done:(p,pns)=" ++ showGhc (b,pns)@@ -392,7 +397,7 @@                           -> GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)                           -> Maybe (SYB.Stage -> Z.Zipper a -> RefactGhc (Z.Zipper a))              liftToMatchQ nm ans (m@(GHC.L _ (GHC.Match _ _pats _mtyp (GHC.GRHSs _rhs ds)))::GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))-                 | (nonEmptyList (definingDeclsRdrNames nm [n] (getHsDecls ans  ds) False False))+                 | (nonEmptyList (definingDeclsRdrNames nm [n] (getHsDecls ans ds) False False))                     = Just (doLiftZ m (getHsDecls ans  ds))                  | otherwise = Nothing @@ -562,15 +567,15 @@          -> RefactGhc [ApplyRefacResult] compDemote fileName (row,col) = do       parseSourceFileGhc fileName-      renamed <- getRefactRenamed       parsed  <- getRefactParsed+      nm <- getRefactNameMap        -- TODO: make the next one an API call, that also gets the       -- parsed source       let (Just (modName,_)) = getModuleName parsed-      let maybePn = locToName (row, col) renamed+      let maybePn = locToRdrName (row, col) parsed       case maybePn of-        Just pn -> demote' modName pn+        Just pn@(GHC.L l _) -> demote' modName (GHC.L l (rdrName2NamePure nm pn))         _       -> error "\nInvalid cursor position!\n"  -- ---------------------------------------------------------------------@@ -625,15 +630,16 @@        = do             logm $ "MoveDef.pnsNeedRenaming' entered"             nm <- getRefactNameMap-            (FN f,DN d) <- hsFDsFromInsideRdr nm dest --f: free variable names that may be shadowed by pn-                                                      --d: declaread variables names that may clash with pn+            let (FN f,DN d) = hsFDsFromInsideRdr nm dest --f: free variable names that may be shadowed by pn+                                                         --d: declaread variables names that may clash with pn             logm $ "MoveDef.pnsNeedRenaming':(f,d)=" ++ showGhc (f,d)-            vs <- hsVisiblePNsRdr nm pn parent  --vs: declarad variables that may shadow pn+            DN vs <- hsVisibleDsRdr nm pn parent  --vs: declarad variables that may shadow pn             logm $ "MoveDef.pnsNeedRenaming':vs=" ++ showGhc vs             let vars = map pNtoName (nub (f `union` d `union` vs) \\ [pn]) -- `union` inscpNames             isInScope <- isInScopeAndUnqualifiedGhc (pNtoName pn) Nothing             logm $ "MoveDef.pnsNeedRenaming:(f,d,vs,vars,isInScope)=" ++ (showGhc (f,d,vs,vars,isInScope))-            if elem (pNtoName pn) vars  || isInScope && findEntity pn dest+            -- if elem (pNtoName pn) vars  || isInScope && findEntity pn dest+            if elem (pNtoName pn) vars  || isInScope && findNameInRdr nm pn dest                then return [pn]                else return []      pNtoName = showGhc@@ -647,7 +653,11 @@   nm <- getRefactNameMap   applyTP (full_buTP (idTP  `adhocTP` (inExp nm))) t   where+#if __GLASGOW_HASKELL__ <= 710     inExp nm (e@(GHC.L l (GHC.HsVar n)) :: GHC.LHsExpr GHC.RdrName) = do+#else+    inExp nm (e@(GHC.L l (GHC.HsVar (GHC.L _ n))) :: GHC.LHsExpr GHC.RdrName) = do+#endif       let ne = rdrName2NamePure nm (GHC.L l n)       if GHC.nameUnique ne == GHC.nameUnique pn          then addActualParamsToRhs pn params e@@ -723,7 +733,7 @@ -- |get the subset of 'pns', which need to be hided in the import -- declaration in module 'mod' -- Note: these are newly exported from the module, so we cannot use--- the GHC name resolution i nthis case.+-- the GHC name resolution in this case. namesNeedToBeHided :: GHC.Module -> [GHC.ModuleName] -> [GHC.Name]    -> RefactGhc [GHC.Name] namesNeedToBeHided clientModule modNames pns = do@@ -785,19 +795,18 @@  -- --------------------------------------------------------------------- +-- |When liftOneLevel is complete, identify whether any new declarations have+-- been put at the top level liftedToTopLevel :: GHC.Located GHC.Name -> GHC.ParsedSource -> RefactGhc (Bool,[GHC.Name])-liftedToTopLevel pnt@(GHC.L _ pn) parsed = do-  -- logm $ "liftedToTopLevel entered"+liftedToTopLevel (GHC.L _ pn) parsed = do+  logm $ "liftedToTopLevel entered:pn=" ++ showGhc pn   nm <- getRefactNameMap-  -- logm $ "liftedToTopLevel:got nm"   decls <- liftT $ hsDecls parsed   let topDecs = definingDeclsRdrNames nm [pn] decls False False   -- ++AZ++ :TODO: we are not updating the nameMap to reflect moved decls   if nonEmptyList topDecs      then do-       (_, parent,_) <- divideDecls decls pnt-       let declsp = parent-       let liftedDecls = definingDeclsRdrNames nm [pn] declsp False False+       let liftedDecls = definingDeclsRdrNames nm [pn] topDecs False False            declaredPns  = nub $ concatMap (definedNamesRdr nm) liftedDecls        return (True, declaredPns)      else return (False, [])@@ -844,7 +853,7 @@          else return (parent,liftedDecls,mLiftedSigs)  -- ----------------------------------------------------------------------+{- -- TODO: perhaps move this to TypeUtils addParamsToSigs :: [GHC.Name] -> GHC.LSig GHC.RdrName -> RefactGhc (GHC.LSig GHC.RdrName) addParamsToSigs [] ms = return ms@@ -1036,6 +1045,7 @@ HsWrapTy HsTyWrapper (HsType name) -} +-}  --------------------------------End of Lifting----------------------------------------- @@ -1063,11 +1073,13 @@   -> RefactGhc [ApplyRefacResult] demote' modName (GHC.L _ pn) = do   renamed <- getRefactRenamed+  parsed  <- getRefactParsed+  nm      <- getRefactNameMap   targetModule <- getRefactTargetModule-  if isFunOrPatName pn renamed+  if isFunOrPatName nm pn parsed     then do        isTl <- isTopLevelPN pn-       if isTl && isExplicitlyExported pn renamed+       if isTl && isExplicitlyExported nm pn parsed           then error "This definition can not be demoted, as it is explicitly exported by the current module!"           else do                   (refactoredMod,declaredPns) <- applyRefac (doDemoting pn) RSAlreadyLoaded@@ -1100,10 +1112,11 @@ doDemotingInClientMod :: [GHC.Name] -> GHC.Module -> RefactGhc () doDemotingInClientMod pns modName = do   logm $ "doDemotingInClientMod:(pns,modName)=" ++ showGhc (pns,modName)-  renamed@(_g,imps,exps,_docs) <- getRefactRenamed-  if any (\pn->findPN pn (hsBinds renamed) || findPN pn (exps)) pns+  (GHC.L _ p) <- getRefactParsed+  nm <- getRefactNameMap+  if any (\pn -> findNameInRdr nm pn (GHC.hsmodDecls p) || findNameInRdr nm pn (GHC.hsmodExports p)) pns      then error $ "This definition can not be demoted, as it is used in the client module '"++(showGhc modName)++"'!"-     else if any (\pn->findPN pn imps) pns+     else if any (\pn->findNameInRdr nm pn (GHC.hsmodImports p)) pns              -- TODO: reinstate this              then do -- (mod',((ts',m),_))<-runStateT (rmItemsFromImport mod pns) ((ts,unmodified),(-1000,0))                      return ()@@ -1250,7 +1263,7 @@                           logm $ "MoveDef:declaredPns=" ++ (showGhc declaredPns) -- ++AZ++ -                         dl <- mapM (flip declaredNamesInTargetPlace ds) declaredPns+                         dl <- mapM (flip (declaredNamesInTargetPlace nm) ds) declaredPns                          logm $ "mapM declaredNamesInTargetPlace done"                          --make sure free variable in 'f' do not clash with variables in 'dl',                          --otherwise do renaming.@@ -1263,14 +1276,6 @@                             else  --duplicate demoted declarations to the right place.                                  do                                     duplicateDecls declaredPns removedDecl demotedSigs t'-                                    {--                                    logm $ "MoveDef: about to duplicateDecls"-                                    dds <- liftT $ hsDecls t'-                                    ds'' <- duplicateDecls declaredPns removedDecl demotedSigs dds-                                    logm $ "MoveDef:duplicateDecls done"-                                    t'' <- liftT $ replaceDecls t' ds''-                                    return t''-                                    -}                   _ ->error "\nThis function/pattern binding is used by more than one friend bindings\n"         else error "This function can not be demoted as it is used in current level!\n"@@ -1285,7 +1290,11 @@                 where                    used :: GHC.LHsDecl GHC.RdrName -> [Int]+#if __GLASGOW_HASKELL__ <= 710                   used (GHC.L _ (GHC.ValD (GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _)))+#else+                  used (GHC.L _ (GHC.ValD (GHC.FunBind _n (GHC.MG (GHC.L _ matches) _ _ _) _ _ _)))+#endif                      = concatMap (usedInMatch pns) matches                    used (GHC.L _ (GHC.ValD (GHC.PatBind pat rhs _ _ _)))@@ -1364,11 +1373,10 @@           ---------------------------------------------------------------------            declaredNamesInTargetPlace :: (SYB.Data t)-                            => GHC.Name -> t-                            -- -> RefactGhc [GHC.Name]+                            => NameMap -> GHC.Name -> t                             -> RefactGhc [GHC.Name] -          declaredNamesInTargetPlace pn' t' = do+          declaredNamesInTargetPlace nm pn' t' = do              logm $ "declaredNamesInTargetPlace:pn=" ++ (showGhc pn')              res <- applyTU (stop_tdTU (failTU                                            `adhocTU` inMatch@@ -1376,18 +1384,19 @@              logm $ "declaredNamesInTargetPlace:res=" ++ (showGhc res)              return res                where-                 inMatch ((GHC.Match _ _pats _ rhs) :: GHC.Match GHC.Name (GHC.LHsExpr GHC.Name))-                    | findPN pn' rhs = do+                 inMatch ((GHC.Match _ _pats _ rhs) :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))+                    | findNameInRdr nm pn' rhs = do                      logm $ "declaredNamesInTargetPlace:inMatch"-                     fds <- hsFDsFromInside rhs-                     return $ snd fds+                     -- fds <- hsFDsFromInside rhs+                     let (_,DN ds) = hsFDsFromInsideRdr nm rhs+                     return ds                  inMatch _ = return mzero -                 inPat ((GHC.PatBind pat rhs _ _ _) :: GHC.HsBind GHC.Name)-                    |findPN pn' rhs = do+                 inPat ((GHC.PatBind pat rhs _ _ _) :: GHC.HsBind GHC.RdrName)+                    |findNameInRdr nm pn' rhs = do                      logm $ "declaredNamesInTargetPlace:inPat"-                     fds <- hsFDsFromInside pat-                     return $ snd fds+                     let (_,DN ds) = hsFDsFromInsideRdr nm pat+                     return ds                  inPat _=  return mzero  -- ---------------------------------------------------------------------@@ -1456,7 +1465,11 @@     where         matchesInDecls :: GHC.LHsDecl GHC.RdrName -> [GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)]+#if __GLASGOW_HASKELL__ <= 710        matchesInDecls (GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _))) = matches+#else+       matchesInDecls (GHC.L _ (GHC.ValD (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _))) = matches+#endif        matchesInDecls _x = []         patsInMatch (GHC.L _ (GHC.Match _ pats' _ _)) = pats'@@ -1472,7 +1485,11 @@           nm <- getRefactNameMap           SYB.everywhereMStaged SYB.Parser (SYB.mkM (worker nm) `SYB.extM` (workerBind nm)) decls           where+#if __GLASGOW_HASKELL__ <= 710           worker nm (match'@(GHC.L _ (GHC.FunBind ln _ (GHC.MG _matches _ _ _) _ _ _)) :: GHC.LHsBind GHC.RdrName)+#else+          worker nm (match'@(GHC.L _ (GHC.FunBind ln (GHC.MG _matches _ _ _) _ _ _)) :: GHC.LHsBind GHC.RdrName)+#endif             = do                 logm $ "foldInDemotedDecls:rdrName2NamePure nm ln=" ++ show (rdrName2NamePure nm ln)                 if isJust (find (== rdrName2NamePure nm ln) pns')@@ -1628,8 +1645,9 @@                        -> GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)                        -> RefactGhc [GHC.Name]        getClashedNames nm oldNames newNames match'-         = do  (_f,DN d) <- hsFDsFromInsideRdr nm match'-               ds' <- mapM (flip (hsVisiblePNsRdr nm) match') oldNames+         = do  let (_f,DN d) = hsFDsFromInsideRdr nm match'+               ds'' <- mapM (flip (hsVisibleDsRdr nm) match') oldNames+               let ds' = map (\(DN ds) -> ds) ds''                -- return clashed names                return (filter (\x->elem ({- pNtoName -} x) newNames)  --Attention: nub                                    ( nub (d `union` (nub.concat) ds')))@@ -1659,8 +1677,8 @@   everywhereMStaged' SYB.Parser (SYB.mkM worker) decls  -- | return True if pn is a local function/pattern name-isLocalFunOrPatName :: SYB.Data t => GHC.Name -> t -> Bool-isLocalFunOrPatName pn scope- = isLocalPN pn && isFunOrPatName pn scope+isLocalFunOrPatName :: SYB.Data t => NameMap -> GHC.Name -> t -> Bool+isLocalFunOrPatName nm pn scope+ = isLocalPN pn && isFunOrPatName nm pn scope  -- EOF

src/Language/Haskell/Refact/Refactoring/Renaming.hs view

@@ -3,8 +3,6 @@   , compRename   ) where -import qualified Data.Generics.Schemes as SYB-import qualified Data.Generics.Aliases as SYB import qualified GHC.SYB.Utils         as SYB  import qualified GHC@@ -12,7 +10,6 @@ import qualified RdrName               as GHC  import Control.Monad-import Data.Maybe import Data.List  import qualified Language.Haskell.GhcMod as GM (Options(..))@@ -64,18 +61,22 @@     logm $ "Renaming.comp: (fileName,newName,(row,col))=" ++ show (fileName,newName,(row,col))     parseSourceFileGhc fileName -    renamed      <- getRefactRenamed     parsed       <- getRefactParsed     modu         <- getModule     targetModule <- getRefactTargetModule+    nm           <- getRefactNameMap +    -- logDataWithAnns "parsed" parsed+     let modName = maybe (GHC.mkModuleName "Main") fst $ getModuleName parsed-        maybePn = locToName (row, col) renamed+        maybePn = locToRdrName (row, col) parsed      logm $ "Renamed.comp:maybePn=" ++ showGhc maybePn -- ++AZ++      case maybePn of-        Just pn@(GHC.L _ n) -> do+        Just pn'@(GHC.L l _) -> do+            let n = rdrName2NamePure nm pn'+                pn = GHC.L l n             logm $ "Renaming:(n,modu)=" ++ showGhc (n,modu)              let (GHC.L _ rdrName) = gfromJust "Renaming.comp.2" $ locToRdrName (row, col) parsed@@ -124,25 +125,20 @@ --------Rename a value variable name-------------------------------- doRenaming pn@(GHC.L _ oldn) rdrNameStr newNameStr newNameGhc modName = do     logm $ "doRenaming:(pn,rdrNameStr,newNameStr) = " ++ showGhc (pn,rdrNameStr,newNameStr)-    renamed <- getRefactRenamed-    void $ SYB.everywhereM (SYB.mkM renameInMod) renamed+    renameTopLevelVarName oldn newNameStr newNameGhc modName True True     logm "doRenaming done"     isExported oldn-  where-    -- 1. The name is declared in a module(top level name)-    renameInMod :: GHC.RenamedSource -> RefactGhc GHC.RenamedSource-    renameInMod ren = do-        logm "renameInMod"-        renameTopLevelVarName oldn newNameStr newNameGhc modName ren True True -renameTopLevelVarName :: GHC.Name -> String -> GHC.Name -> GHC.ModuleName -> GHC.RenamedSource-                      -> Bool -> Bool -> RefactGhc GHC.RenamedSource-renameTopLevelVarName oldPN newName newNameGhc modName renamed existChecking exportChecking = do+renameTopLevelVarName :: GHC.Name -> String -> GHC.Name -> GHC.ModuleName+                      -> Bool -> Bool -> RefactGhc ()+renameTopLevelVarName oldPN newName newNameGhc modName existChecking exportChecking = do     logm $ "renameTopLevelVarName:(existChecking, exportChecking)=" ++ show (existChecking, exportChecking)     causeAmbiguity <- causeAmbiguityInExports oldPN newNameGhc+    parsed <- getRefactParsed+    nm <- getRefactNameMap      -- f' contains names imported from other modules;      -- d' contains the top level names declared in this module;-    (f', d') <- hsFDsFromInside renamed+    let (FN f', DN d') = hsFDsFromInsideRdr nm parsed      --filter those qualified free variables in f'     -- let (f,d) = ((nub.map pNtoName.filter (not.isQualifiedPN)) f', (nub.map pNtoName) d')     let (f, d) = (map nameToString f', map nameToString d')@@ -169,7 +165,7 @@         --the same name has been declared in this module.         error $ mconcat ["Name '", newName, "' already exists in this module\n"] -    when (exportChecking && causeNameClashInExports oldPN newNameGhc modName renamed) $+    when (exportChecking && causeNameClashInExports nm oldPN newNameGhc modName parsed) $         error "The new name will cause conflicting exports, please select another new name!"     when (exportChecking && causeAmbiguity) . -- causeAmbiguityInExports oldPN  newNameGhc {- inscps -} renamed         error $ mconcat ["The new name will cause ambiguity in the exports of module '"@@ -182,17 +178,17 @@     isInScopeUnqual <- isInScopeAndUnqualifiedGhc newName (Just newNameGhc)     logm "renameTopLevelVarName:after isInScopeUnqual"     logm $ "renameTopLevelVarName:oldPN=" ++ showGhc oldPN-    ds <- hsVisibleNames oldPN renamed+    ds <- hsVisibleNamesRdr oldPN parsed     logm $ "renameTopLevelVarName:ds computed=" ++ show ds     when (existChecking && newName `elem` nub (ds `union` f) \\ [nameToString oldPN]) .         error $ mconcat [ "Name '", newName, "' already exists, or renaming '", nameToString oldPN,  "' to '"                         , newName, "' will change the program's semantics!\n"]      logm "renameTopLevelVarName start..:should have qualified"-    parsed <- renamePN oldPN newNameGhc (exportChecking && isInScopeUnqual) =<< getRefactParsed-    putRefactParsed parsed mempty+    let qual = if (exportChecking && isInScopeUnqual) then Qualify else PreserveQualify+    parsed' <- renamePN oldPN newNameGhc qual parsed+    putRefactParsed parsed' mempty     logm "renameTopLevelVarName done:should have qualified"-    getRefactRenamed  ------------------------------------------------------------------------ @@ -203,8 +199,9 @@     logm $ "renameInClientMod:(newNameGhc module)=" ++ showGhc (GHC.nameModule newNameGhc) -- ++AZ++     getTargetGhc targetModule -    renamed <- getRefactRenamed     modName <- getRefactModuleName+    parsed  <- getRefactParsed+    nm      <- getRefactNameMap      -- We need to find the old name in the module, and get it as a     -- GHC.Name to know what to look for in the call to renamePN', as it@@ -224,14 +221,15 @@     -- logm $ "renameInClientMod:(uniques:newNames,oldPN)=" ++ showGhcQual (map GHC.nameUnique newNames,GHC.nameUnique oldPN)     case newNames of         []        -> return []-        [oldName] | findPN oldName renamed -> doRenameInClientMod oldName modName renamed+        -- [oldName] | findPN oldName renamed -> doRenameInClientMod oldName modName renamed+        [oldName] | findNameInRdr nm oldName parsed -> doRenameInClientMod nm oldName modName parsed                   | otherwise -> do                       logm "renameInClientMod: name not present in module, returning"                       return []         ns -> error $ "HaRe: renameInClientMod: could not find name to replace, got:" ++ showGhcQual ns    where-    doRenameInClientMod oldNameGhc modName renamed = do+    doRenameInClientMod nm oldNameGhc modName parsed = do         -- There are two different tests we need to do here         -- 1. Does the new name clash with some existing name in the         --    client mod, in which case it must be qualified@@ -244,11 +242,12 @@          if isInScopeUnqualNew -- ++AZ++: should this be negated?             then do-                (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc True)+                -- (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc True)+                (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc Qualify)                                                 RSAlreadyLoaded                 return [refactoredMod]             else do-                when (causeNameClashInExports oldPN newNameGhc modName renamed) .+                when (causeNameClashInExports nm oldPN newNameGhc modName parsed) .                     error $ mconcat [ "The new name will cause conflicting exports in module"                                     , show newName, ", please select another name!"]                 -- (refactoredMod,_) <- applyRefac (refactRenameComplex oldPN newName newNameGhc) RSAlreadyLoaded@@ -257,7 +256,7 @@                 -- TODO: implement rest of this                 return [refactoredMod] -    refactRenameSimple :: GHC.Name -> String -> GHC.Name -> Bool -> RefactGhc ()+    refactRenameSimple :: GHC.Name -> String -> GHC.Name -> HowToQual -> RefactGhc ()     refactRenameSimple old newStr new useQual = do         logm $ "refactRenameSimple:(old,newStr,new,useQual)=" ++ showGhc (old, newStr, new, useQual)         qualifyTopLevelVar newStr@@ -283,13 +282,16 @@         logm $ "renameInClientMod.worker:(oldPN',newName',newNameGhc')=" ++                showGhc (oldPN', newName', newNameGhc')         isInScopeUnqualNew <- isInScopeAndUnqualifiedGhc newName' Nothing-        vs <- hsVisibleNames oldPN' =<< getRefactRenamed  -- Does this check names other than variable names?+        vs <- hsVisibleNamesRdr oldPN' =<< getRefactParsed  -- Does this check names other than variable names?         logm $ "renameInClientMod.worker:(vs,oldPN',isInScopeUnqualNew)=" ++                showGhc (vs, oldPN', isInScopeUnqualNew) -        parsed <- renamePN oldPN' newNameGhc'-                          (newName' `elem` (nub vs \\ [nameToString oldPN']) || isInScopeUnqualNew)-                          =<< getRefactParsed+        -- logParsedSource "worker:parsed"++        let qual = if (newName' `elem` (nub vs \\ [nameToString oldPN']) || isInScopeUnqualNew)+                      then Qualify+                      else PreserveQualify+        parsed <- renamePN oldPN' newNameGhc' qual =<< getRefactParsed         putRefactParsed parsed mempty         return ()

src/Language/Haskell/Refact/Refactoring/SwapArgs.hs view

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Language.Haskell.Refact.Refactoring.SwapArgs (swapArgs) where @@ -31,9 +32,10 @@      -> RefactGhc [ApplyRefacResult] comp fileName (row, col) = do        parseSourceFileGhc fileName-       renamed <- getRefactRenamed+       parsed  <- getRefactParsed+       nm      <- getRefactNameMap -       let name = locToName (row, col) renamed+       let name = locToNameRdrPure nm (row, col) parsed         case name of             -- (Just pn) -> do refactoredMod@(_, (_t, s)) <- applyRefac (doSwap pnt pn) (Just modInfo) fileName@@ -55,8 +57,8 @@        -- putStrLn "Completd"  -doSwap :: (GHC.Located GHC.Name) -> RefactGhc ()-doSwap (GHC.L _s n1) = do+doSwap :: GHC.Name -> RefactGhc ()+doSwap n1 = do     parsed <- getRefactParsed     logm $ "doSwap:parsed=" ++ SYB.showData SYB.Parser 0 parsed     nm <- getRefactNameMap@@ -71,11 +73,19 @@      where          -- 1. The definition is at top level...+#if __GLASGOW_HASKELL__ <= 710          inMod nm ((GHC.FunBind ln2 infixity (GHC.MG matches p m1 m2) a locals tick)::GHC.HsBind GHC.RdrName)+#else+         inMod nm ((GHC.FunBind ln2 (GHC.MG (GHC.L lm matches) p m1 m2) a locals tick)::GHC.HsBind GHC.RdrName)+#endif             | GHC.nameUnique n1 == GHC.nameUnique (rdrName2NamePure nm ln2)                     = do logm ("inMatch>" ++ SYB.showData SYB.Parser 0 ln2 ++ "<")                          newMatches <- updateMatches matches+#if __GLASGOW_HASKELL__ <= 710                          return (GHC.FunBind ln2 infixity (GHC.MG newMatches p m1 m2) a locals tick)+#else+                         return (GHC.FunBind ln2 (GHC.MG (GHC.L lm newMatches) p m1 m2) a locals tick)+#endif          inMod _ func = return func           -- 2. All call sites of the function...@@ -94,7 +104,11 @@          inExp _ e = return e           -- 3. Type signature...+#if __GLASGOW_HASKELL__ <= 710          inType nm (GHC.L x (GHC.TypeSig [lname] types pns)::GHC.LSig GHC.RdrName)+#else+         inType nm (GHC.L x (GHC.TypeSig [lname] (GHC.HsIB ivs (GHC.HsWC wcs mwc types)))::GHC.LSig GHC.RdrName)+#endif            | GHC.nameUnique (rdrName2NamePure nm lname) == GHC.nameUnique n1                 = do                      logm $ "doSwap.inType"@@ -103,9 +117,17 @@                      -- t2' <- update t2 t1 t2                      let t1' = t2                      let t2' = t1+#if __GLASGOW_HASKELL__ <= 710                      return (GHC.L x (GHC.TypeSig [lname] (tyListToFun (t1':t2':ts)) pns))+#else+                     return (GHC.L x (GHC.TypeSig [lname] (GHC.HsIB ivs (GHC.HsWC wcs mwc (tyListToFun (t1':t2':ts))))))+#endif +#if __GLASGOW_HASKELL__ <= 710          inType nm (GHC.L _x (GHC.TypeSig (n:ns) _types _)::GHC.LSig GHC.RdrName)+#else+         inType nm (GHC.L _x (GHC.TypeSig (n:ns) _types )::GHC.LSig GHC.RdrName)+#endif            | GHC.nameUnique n1 `elem` (map (\n' -> GHC.nameUnique (rdrName2NamePure nm n')) (n:ns))             = error "Error in swapping arguments in type signature: signature bound to muliple entities!" @@ -116,7 +138,11 @@            return (GHC.L l (GHC.SigD s'))          inTypeDecl _ x = return x +#if __GLASGOW_HASKELL__ <= 710          tyFunToList (GHC.L _ (GHC.HsForAllTy _ _ _ _ (GHC.L _ (GHC.HsFunTy t1 t2)))) = t1 : (tyFunToList t2)+#else+         tyFunToList (GHC.L _ (GHC.HsForAllTy _ (GHC.L _ (GHC.HsFunTy t1 t2)))) = t1 : (tyFunToList t2)+#endif          tyFunToList (GHC.L _ (GHC.HsFunTy t1 t2)) = t1 : (tyFunToList t2)          tyFunToList t = [t]

− src/Language/Haskell/Refact/Utils/Binds.hs

@@ -1,425 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE UndecidableInstances #-} -- for GHC.DataId------------------------------------------------------------------------------------- Module      : TypeUtils---- Maintainer  : refactor-fp\@kent.ac.uk--- |------ This module contains a collection of program analysis and--- transformation functions (the API) that work over the Type--- Decorated AST. Most of the functions defined in the module are--- taken directly from the API, but in some cases are modified to work--- with the type decorated AST.------ In particular some new functions have been added to make type--- decorated AST traversals easier.------ In HaRe, in order to preserve the comments and layout of refactored--- programs, a refactoring modifies not only the AST but also the--- token stream, and the program source after the refactoring is--- extracted from the token stream rather than the AST, for the--- comments and layout information is kept in the token steam instead--- of the AST. As a consequence, a program transformation function--- from this API modifies both the AST and the token stream (unless--- explicitly stated). So when you build your own program--- transformations, try to use the API to do the transformation, as--- this can liberate you from caring about the token stream.------ This type decorated API is still in development. Any suggestions--- and comments are very much welcome.------------------------------------------------------------------------------------module Language.Haskell.Refact.Utils.Binds-   (-     hsBinds-   , getValBindSigs-   , HsValBinds(..)- ) where--import Language.Haskell.GHC.ExactPrint.Utils---- Modules from GHC-import qualified Bag           as GHC-import qualified GHC           as GHC-import qualified Outputable    as GHC--import Data.Generics---- -----------------------------------------------------------------------bindsFromDecls :: [GHC.LHsDecl name] -> GHC.HsValBinds name-bindsFromDecls ds = GHC.ValBindsIn (GHC.listToBag binds) sigs-  where-    binds = concatMap goBind ds-    goBind (GHC.L l (GHC.ValD d)) = [(GHC.L l d)]-    goBind _ = []--    sigs = concatMap goSig ds-    goSig (GHC.L l (GHC.SigD d)) = [(GHC.L l d)]-    goSig _ = []---- -----------------------------------------------------------------------getValBindSigs :: GHC.HsValBinds GHC.RdrName -> [GHC.LSig GHC.RdrName]-getValBindSigs binds = case binds of-    GHC.ValBindsIn  _  sigs -> sigs-    GHC.ValBindsOut _ _sigs -> []--emptyValBinds :: GHC.HsValBinds name-emptyValBinds = GHC.ValBindsIn (GHC.listToBag []) []--unionBinds :: [GHC.HsValBinds name] ->  GHC.HsValBinds name-unionBinds [] = emptyValBinds-unionBinds [x] = x-unionBinds (x1:x2:xs) = unionBinds ((mergeBinds x1 x2):xs)-  where-    mergeBinds :: GHC.HsValBinds name -> GHC.HsValBinds name -> GHC.HsValBinds name-    mergeBinds (GHC.ValBindsIn b1 s1) (GHC.ValBindsIn b2 s2) = (GHC.ValBindsIn (GHC.unionBags b1 b2) (s1++s2))-    mergeBinds (GHC.ValBindsOut b1 s1) (GHC.ValBindsOut b2 s2) = (GHC.ValBindsOut (b1++b2) (s1++s2))-    mergeBinds y1@(GHC.ValBindsIn _ _) y2@(GHC.ValBindsOut _  _) = mergeBinds y2 y1-    mergeBinds    (GHC.ValBindsOut _ _) (GHC.ValBindsIn _ _) = error $ "unionBinds:cannot merge ValBindsOut and ValBindsIn"---- NOTE: ValBindsIn are found before the Renamer, ValBindsOut after--hsBinds :: (HsValBinds t name) => t -> [GHC.LHsBind name]-hsBinds t = case hsValBinds t of-  GHC.ValBindsIn binds _sigs -> GHC.bagToList binds-  GHC.ValBindsOut bs _sigs -> concatMap (\(_,b) -> GHC.bagToList b) bs---- This class replaces the HsDecls one-class (Data t,Data name) => HsValBinds t name |  t -> name where--    -- | Return the binds that are directly enclosed in the-    -- given syntax phrase.-    -- hsValBinds :: t -> [GHC.LHsBind GHC.Name]-    hsValBinds :: t -> GHC.HsValBinds name--    -- | Return the type class definitions that are directly enclosed-    -- in the given syntax phrase. Note: only makes sense for-    -- GHC.RenamedSource-    hsTyDecls :: t -> [[GHC.LTyClDecl name]]---instance HsValBinds GHC.ParsedSource GHC.RdrName where-  hsValBinds (GHC.L _ (GHC.HsModule _ _ _ ds _ _)) = bindsFromDecls ds--  -- hsTyDecls (grp,_,_,_) = map GHC.group_tyclds (GHC.hs_tyclds grp)-  hsTyDecls (GHC.L _ (GHC.HsModule _ _ _ _ds _ _)) = []--instance HsValBinds GHC.RenamedSource GHC.Name where-  hsValBinds (grp,_,_,_) = (GHC.hs_valds grp)--  hsTyDecls (grp,_,_,_) = map GHC.group_tyclds (GHC.hs_tyclds grp)--instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.HsValBinds name) name where-  hsValBinds vb = vb-  hsTyDecls _ = []--instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.HsGroup name) name where-  hsValBinds grp = (GHC.hs_valds grp)--  hsTyDecls _ = []--instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.HsLocalBinds name) name where-  hsValBinds lb = case lb of-    GHC.HsValBinds b    -> b-    GHC.HsIPBinds _     -> emptyValBinds-    GHC.EmptyLocalBinds -> emptyValBinds--  hsTyDecls _ = []--instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.GRHSs name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.GRHSs _ lb) = hsValBinds lb--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.MatchGroup name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.MG matches _ _ _) = hsValBinds matches--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds [GHC.LMatch name (GHC.LHsExpr name)] name where-  hsValBinds ms = unionBinds $ map (\m -> hsValBinds $ GHC.unLoc m) ms--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.LMatch name (GHC.LHsExpr name)) name where-  hsValBinds m = hsValBinds $ GHC.unLoc m--  hsTyDecls _ = []---- ------------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.Match name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.Match _ _ _ grhs) = hsValBinds grhs--  hsTyDecls _ = []--instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.HsBind name) name where-  hsValBinds (GHC.PatBind _p rhs _typ _fvs _) = hsValBinds rhs--  -- TODO: ++AZ++ added for compatibility with hsDecls.-  hsValBinds (GHC.FunBind _ _ matches _ _ _) = hsValBinds matches-  hsValBinds other = error $ "hsValBinds (GHC.HsBind name) undefined for:" ++ (showGhc other)--  hsTyDecls _ = []--instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.HsExpr name) name where-  hsValBinds (GHC.HsLet ds _) = hsValBinds ds-  hsValBinds x = error $ "TypeUtils.hsValBinds undefined for:" ++ showGhc x--  hsTyDecls _ = []--instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.Stmt name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.LetStmt ds) = hsValBinds ds-  hsValBinds other = error $ "hsValBinds (GHC.Stmt name) undefined for:" ++ (showGhc other)--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LHsBinds name) name where-  hsValBinds binds = hsValBinds $ GHC.bagToList binds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LHsBind name) name where-  hsValBinds (GHC.L _ (GHC.FunBind _ _ matches _ _ _)) = hsValBinds matches-  hsValBinds (GHC.L _ (GHC.PatBind _ rhs _ _ _))       = hsValBinds rhs-  hsValBinds (GHC.L _ (GHC.VarBind _ rhs _))           = hsValBinds rhs-  hsValBinds (GHC.L _ (GHC.AbsBinds _ _ _ _ binds))    = hsValBinds binds-  hsValBinds (GHC.L _ (GHC.PatSynBind _))      = error "hsValBinds: PaySynBind to implement"--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds ([GHC.LHsBind name]) name where-  -- hsValBinds xs = concatMap hsValBinds xs -- As in original-  hsValBinds xs = GHC.ValBindsIn (GHC.listToBag xs) []--  hsTyDecls _ = []--instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LHsExpr name) name where-  hsValBinds (GHC.L _ (GHC.HsLet binds _ex)) = hsValBinds binds-  hsValBinds _                               = emptyValBinds--  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LGRHS name (GHC.LHsExpr name)] name where-  hsValBinds xs = unionBinds $ map hsValBinds xs-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LGRHS name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.L _ (GHC.GRHS stmts _expr)) = hsValBinds stmts-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LStmt name (GHC.LHsExpr name)] name where-  hsValBinds xs = unionBinds $ map hsValBinds xs-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LStmt name (GHC.LHsExpr name)) name where-  hsValBinds (GHC.L _ (GHC.LetStmt binds)) = hsValBinds binds-  hsValBinds _                             = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LPat name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LPat name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- ------------------------------------------------------------------------instance HsValBinds (GHC.Name) GHC.Name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []----- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.SyntaxExpr name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.TyClGroup name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.TyClGroup name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [[GHC.LTyClDecl name]] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LTyClDecl name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LTyClDecl name) name where-  hsValBinds _ = error $ "hsValBinds (GHC.LTyClDecl name) must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LTyFamInstDecl name] name where-  hsValBinds _ = error $ "hsValBinds [GHC.LTyFamInstDecl name] must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LDataFamInstDecl name] name where-  hsValBinds _ = error $ "hsValBinds [GHC.LDataFamInstDecl name] must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds [GHC.LTyFamInstEqn name] name where-  hsValBinds _ = error $ "hsValBinds [GHC.LTyFamInstEqn name] must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.DataId name,Data name)-  => HsValBinds (GHC.LTyFamInstEqn name) name where-  hsValBinds _ = error $ "hsValBinds (GHC.LTyFamInstEqn name) must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.HsDataDefn name) name where-  hsValBinds _ = error $ "hsValBinds (GHC.HsDataDefn name) must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.HsTyPats name) name where-  hsValBinds _ = error $ "hsValBinds (GHC.HsTyPats name) must pull out tcdMeths"-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LInstDecl name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LInstDecl name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LHsType name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LHsType name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds [GHC.LSig name] name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.LSig name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- -----------------------------------------------------------------------instance (GHC.OutputableBndr name,GHC.DataId name,Data name)-  => HsValBinds (GHC.HsIPBinds name) name where-  hsValBinds _ = emptyValBinds-  hsTyDecls _ = []---- EOF-

src/Language/Haskell/Refact/Utils/ExactPrint.hs view

@@ -8,18 +8,32 @@     replace   , replaceAnnKey   , copyAnn++  , setAnnKeywordDP+  , clearPriorComments+  , balanceAllComments   ) where  import qualified GHC           as GHC  import qualified Data.Generics as SYB +import Control.Monad++import Language.Haskell.GHC.ExactPrint.Transform import Language.Haskell.GHC.ExactPrint.Types+-- import Language.Haskell.GHC.ExactPrint.Utils +import Language.Haskell.Refact.Utils.GhcUtils+ import qualified Data.Map as Map  -- --------------------------------------------------------------------- +-- ++AZ++:TODO: Move this to ghc-exactprint+-- |The annotations are keyed to the constructor, so if we replace a qualified+-- with an unqualified RdrName or vice versa we have to rebuild the key for the+-- appropriate annotation. replaceAnnKey :: (SYB.Data old,SYB.Data new)   => GHC.Located old -> GHC.Located new -> Anns -> Anns replaceAnnKey old new ans =@@ -33,14 +47,13 @@  -- --------------------------------------------------------------------- +-- ++AZ++ TODO: migrate this to ghc-exactprint copyAnn :: (SYB.Data old,SYB.Data new)   => GHC.Located old -> GHC.Located new -> Anns -> Anns copyAnn old new ans =   case Map.lookup (mkAnnKey old) ans of     Nothing -> ans-    Just v ->  anns'-      where-        anns' = Map.insert (mkAnnKey new) v ans+    Just v  -> Map.insert (mkAnnKey new) v ans  -- --------------------------------------------------------------------- @@ -69,5 +82,81 @@ moveAnns [] xs        = xs moveAnns ((_, dp): _) ((kw, _):xs) = (kw,dp) : xs moveAnns _ []         = []++-- ---------------------------------------------------------------------++-- |Change the @DeltaPos@ for a given @KeywordId@ if it appears in the+-- annotation for the given item.+setAnnKeywordDP :: (SYB.Data a) => GHC.Located a -> KeywordId -> DeltaPos -> Transform ()+setAnnKeywordDP la kw dp = modifyAnnsT changer+  where+    changer ans = case Map.lookup (mkAnnKey la) ans of+      Nothing -> ans+      Just an -> Map.insert (mkAnnKey la) (an {annsDP = map update (annsDP an)}) ans+    update (kw',dp')+      | kw == kw' = (kw',dp)+      | otherwise = (kw',dp')++-- ---------------------------------------------------------------------++-- |Remove any preceding comments from the given item+clearPriorComments :: (SYB.Data a) => GHC.Located a -> Transform ()+clearPriorComments la = do+  edp <- getEntryDPT la+  modifyAnnsT $ \ans ->+    case Map.lookup (mkAnnKey la) ans of+      Nothing -> ans+      Just an -> Map.insert (mkAnnKey la) (an {annPriorComments = [] }) ans+  setEntryDPT la edp++-- ---------------------------------------------------------------------++balanceAllComments :: SYB.Data a => GHC.Located a -> Transform (GHC.Located a)+balanceAllComments la+  -- Must be top-down+  = everywhereM' (SYB.mkM inMod+                     `SYB.extM` inExpr+                     `SYB.extM` inMatch+                     `SYB.extM` inStmt+                   ) la+  where+    inMod :: GHC.ParsedSource -> Transform (GHC.ParsedSource)+    inMod m = doBalance m++    inExpr :: GHC.LHsExpr GHC.RdrName -> Transform (GHC.LHsExpr GHC.RdrName)+    inExpr e = doBalance e++    inMatch :: (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> Transform (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+    inMatch m = doBalance m++    inStmt :: GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Transform (GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName))+    inStmt s = doBalance s++    -- |Balance all comments between adjacent decls, as well as pushing all+    -- trailing comments to the right place.+    {-+    e.g., for++        foo = do+          return x+            where+               x = ['a'] -- do++        bar = undefined++    the "-- do" comment must end up in the trailing comments for "x = ['a']"+    -}+    doBalance t = do+      decls <- hsDecls t+      let+        go [] = return []+        go [x] = return [x]+        go (x1:x2:xs) = do+          balanceComments x1 x2+          go (x2:xs)+      _ <- go decls+      -- replaceDecls t decls'+      unless (null decls) $ moveTrailingComments t (last decls)+      return t  -- ---------------------------------------------------------------------

src/Language/Haskell/Refact/Utils/GhcModuleGraph.hs view

@@ -1,4 +1,5 @@ {-# LANGUAGE PatternGuards #-}+{-# LANGUAGE CPP #-}  module Language.Haskell.Refact.Utils.GhcModuleGraph   (@@ -7,12 +8,16 @@   ) where  -- GHC imports+#if __GLASGOW_HASKELL__ > 710+import BasicTypes+#endif import Digraph import FastString import GHC import HscTypes import Panic + -- Other imports import qualified Data.Map as Map @@ -185,11 +190,13 @@          ++ [ (m,False) | m <- ms_home_imps s ] -} +#if __GLASGOW_HASKELL__ <= 710 home_imps :: [Located (ImportDecl RdrName)] -> [Located ModuleName] home_imps imps = [ ideclName i |  L _ i <- imps, isLocal (ideclPkgQual i) ]   where isLocal Nothing = True         isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special         isLocal _ = False+#endif  {- ms_home_allimps :: ModSummary -> [ModuleName]@@ -197,9 +204,17 @@ -}  ms_home_srcimps :: ModSummary -> [Located ModuleName]+#if __GLASGOW_HASKELL__ <= 710 ms_home_srcimps = home_imps . ms_srcimps+#else+ms_home_srcimps ms = map snd $ ms_srcimps ms+#endif  ms_home_imps :: ModSummary -> [Located ModuleName]+#if __GLASGOW_HASKELL__ <= 710 ms_home_imps = home_imps . ms_imps+#else+ms_home_imps ms = map snd $ ms_imps ms+#endif  -- GHC source end

src/Language/Haskell/Refact/Utils/GhcUtils.hs view

@@ -19,7 +19,6 @@     , everywhereMStaged'     , everywhereStaged     , everywhereStaged'-    , onelayerStaged     , listifyStaged      -- ** SYB Utility@@ -143,7 +142,7 @@ -}  -- ----------------------------------------------------------------------+{- -- |Perform a query on the immediate subterms only, avoiding holes onelayerStaged :: SYB.Stage -> r -> SYB.GenericQ r -> SYB.GenericQ [r] onelayerStaged _stage _z f t = gmapQ stagedF t@@ -154,7 +153,7 @@       | checkItemStage stage x = z #endif       | otherwise = f x-+-} -- ---------------------------------------------------------------------  -- | Staged variation of SYB.listify

src/Language/Haskell/Refact/Utils/Monad.hs view

@@ -16,6 +16,7 @@        , RefactSettings(..)        , RefactState(..)        , RefactModule(..)+       , RefacSource(..)        , TargetModule        , Targets        , CabalGraph@@ -145,6 +146,11 @@ When HaRe needs a new SrcSpan, for this, it generates it from this field, to ensure uniqueness. -}++data RefacSource = RSFile FilePath+                 | RSTarget TargetModule+                 | RSMod GHC.ModSummary+                 | RSAlreadyLoaded  type TargetModule = GM.ModulePath -- From ghc-mod

src/Language/Haskell/Refact/Utils/MonadFunctions.hs view

@@ -4,6 +4,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE CPP #-}  -- | @@ -41,6 +42,7 @@        , getRefactModule        , getRefactModuleName        , getRefactNameMap+       , addToNameMap         -- * New ghc-exactprint interfacing        , liftT@@ -64,6 +66,7 @@        , logDataWithAnns        , logAnns        , logParsedSource+       , logExactprint         -- * For use by the tests only        , initRefactModule@@ -79,10 +82,14 @@ import qualified Module        as GHC import qualified Name          as GHC import qualified Unique        as GHC+#if __GLASGOW_HASKELL__ > 710+import qualified Var+#endif  import qualified Data.Generics as SYB  import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Annotate import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Utils @@ -345,6 +352,20 @@  -- --------------------------------------------------------------------- +addToNameMap :: GHC.SrcSpan -> GHC.Name -> RefactGhc ()+addToNameMap ss n = do+  s <- get+  let mtm = rsModule s+  case mtm of+    Nothing  -> error $ "Hare.MonadFunctions.addToNameMap:no module loaded"+    Just tm -> do+      let nm = rsNameMap tm+          nm' = Map.insert ss n nm+          mtm' = Just tm { rsNameMap = nm'}+      put s { rsModule = mtm'}++-- ---------------------------------------------------------------------+ getRefactDone :: RefactGhc Bool getRefactDone = do   flags <- gets rsFlags@@ -384,6 +405,13 @@  -- --------------------------------------------------------------------- +logExactprint :: (Annotate a) => String -> GHC.Located a -> RefactGhc ()+logExactprint str ast = do+  anns <- getRefactAnns+  logm $ str ++ "\n[" ++ exactPrint ast anns ++ "]"++-- ---------------------------------------------------------------------+ logAnns :: String -> RefactGhc () logAnns str = do   anns <- getRefactAnns@@ -427,6 +455,9 @@   where     parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module tm     renamed = gfromJust "initRdrNameMap" $ GHC.tm_renamed_source tm+#if __GLASGOW_HASKELL__ > 710+    typechecked = GHC.tm_typechecked_source tm+#endif      checkRdr :: GHC.Located GHC.RdrName -> Maybe [(GHC.SrcSpan,GHC.RdrName)]     checkRdr (GHC.L l n@(GHC.Unqual _)) = Just [(l,n)]@@ -437,8 +468,26 @@     checkName ln = Just [ln]      rdrNames = gfromJust "initRdrNameMap" $ SYB.everything mappend (nameSybQuery checkRdr ) parsed+#if __GLASGOW_HASKELL__ <= 710     names    = gfromJust "initRdrNameMap" $ SYB.everything mappend (nameSybQuery checkName) renamed+#else+    names1   = gfromJust "initRdrNameMap" $ SYB.everything mappend (nameSybQuery checkName) renamed+    names2 = names1 ++ SYB.everything (++) ([] `SYB.mkQ` fieldOcc+                                              `SYB.extQ` hsRecFieldN) renamed+    names  = names2 ++ SYB.everything (++) ([] `SYB.mkQ` hsRecFieldT) typechecked +    fieldOcc :: GHC.FieldOcc GHC.Name -> [GHC.Located GHC.Name]+    fieldOcc (GHC.FieldOcc (GHC.L l _) n) = [(GHC.L l n)]++    hsRecFieldN :: GHC.LHsExpr GHC.Name -> [GHC.Located GHC.Name]+    hsRecFieldN (GHC.L _ (GHC.HsRecFld (GHC.Unambiguous (GHC.L l _) n) )) = [GHC.L l n]+    hsRecFieldN _ = []++    hsRecFieldT :: GHC.LHsExpr GHC.Id -> [GHC.Located GHC.Name]+    hsRecFieldT (GHC.L _ (GHC.HsRecFld (GHC.Ambiguous (GHC.L l _) n) )) = [GHC.L l (Var.varName n)]+    hsRecFieldT _ = []+#endif+     nameMap = Map.fromList $ map (\(GHC.L l n) -> (l,n)) names      -- If the name does not exist (e.g. a TH Splice that has been expanded, make a new one)@@ -447,7 +496,11 @@       Just v -> v       Nothing -> case n of                    GHC.Unqual u -> mkNewGhcNamePure 'h' i Nothing  (GHC.occNameString u)+#if __GLASGOW_HASKELL__ <= 710                    GHC.Qual q u -> mkNewGhcNamePure 'h' i (Just (GHC.Module (GHC.stringToPackageKey "") q)) (GHC.occNameString u)+#else+                   GHC.Qual q u -> mkNewGhcNamePure 'h' i (Just (GHC.Module (GHC.stringToUnitId "") q)) (GHC.occNameString u)+#endif                    _            -> error "initRdrNameMap:should not happen"      r = Map.fromList $ map (\((l,n),i) -> (l,lookupName l n i)) $ zip rdrNames [1..]@@ -469,15 +522,18 @@ nameSybTransform changer = q   where     q = SYB.mkM  worker+#if __GLASGOW_HASKELL__ <= 710         `SYB.extM` workerBind         `SYB.extM` workerExpr         `SYB.extM` workerLIE         `SYB.extM` workerHsTyVarBndr         `SYB.extM` workerLHsType+#endif      worker (pnt :: (GHC.Located GHC.RdrName))       = changer pnt +#if __GLASGOW_HASKELL__ <= 710     workerBind (GHC.L l (GHC.VarPat name))       = do         (GHC.L _ n) <- changer (GHC.L l name)@@ -507,6 +563,7 @@           (GHC.L _ n) <- changer (GHC.L l name)           return (GHC.L l (GHC.HsTyVar n))     workerLHsType x = return x+#endif  -- --------------------------------------------------------------------- @@ -515,15 +572,18 @@ nameSybQuery checker = q   where     q = Nothing `SYB.mkQ`  worker+#if __GLASGOW_HASKELL__ <= 710                 `SYB.extQ` workerBind                 `SYB.extQ` workerExpr-                `SYB.extQ` workerLIE+                -- `SYB.extQ` workerLIE                 `SYB.extQ` workerHsTyVarBndr                 `SYB.extQ` workerLHsType+#endif      worker (pnt :: (GHC.Located a))       = checker pnt +#if __GLASGOW_HASKELL__ <= 710     workerBind (GHC.L l (GHC.VarPat name))       = checker (GHC.L l name)     workerBind _ = Nothing@@ -532,9 +592,9 @@       = checker (GHC.L l name)     workerExpr _ = Nothing -    workerLIE ((GHC.L _l (GHC.IEVar (GHC.L ln name))) :: (GHC.LIE a))-      = checker (GHC.L ln name)-    workerLIE _ = Nothing+    -- workerLIE ((GHC.L _l (GHC.IEVar (GHC.L ln name))) :: (GHC.LIE a))+    --   = checker (GHC.L ln name)+    -- workerLIE _ = Nothing      workerHsTyVarBndr ((GHC.L l (GHC.UserTyVar name)))       = checker (GHC.L l name)@@ -543,12 +603,15 @@     workerLHsType ((GHC.L l (GHC.HsTyVar name)))       = checker (GHC.L l name)     workerLHsType _ = Nothing+#endif  -- ---------------------------------------------------------------------  parseDeclWithAnns :: String -> RefactGhc (GHC.LHsDecl GHC.RdrName) parseDeclWithAnns src = do-  let label = "<interactive"+  u <- gets rsUniqState+  putUnique (u+1)+  let label = "HaRe-" ++ show (u + 1)   r  <- GHC.liftIO $ withDynFlags (\df -> parseDecl df label src)   case r of     Left err -> error (show err)

src/Language/Haskell/Refact/Utils/TypeSyn.hs view

@@ -1,5 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}  -- | This is a legacy module from the pre-GHC HaRe, and will disappear -- eventually.@@ -80,12 +81,13 @@                                           GHC.<+> GHC.ppr name                                           GHC.<+> GHC.ppr typ                                           GHC.<+> GHC.ppr doc-+#if __GLASGOW_HASKELL__ <= 710 instance GHC.Outputable (GHC.TyFamEqn GHC.Name (GHC.LHsTyVarBndrs GHC.Name)) where   ppr (GHC.TyFamEqn name pats rhs) = GHC.text "TyFamEqn"                                           GHC.<+> GHC.ppr name                                           GHC.<+> GHC.ppr pats                                           GHC.<+> GHC.ppr rhs+#endif  -- ---------------------------------------------------------------------

src/Language/Haskell/Refact/Utils/TypeUtils.hs view

@@ -43,2247 +43,2547 @@     inScopeInfo, isInScopeAndUnqualified, isInScopeAndUnqualifiedGhc, inScopeNames    , isExported, isExplicitlyExported, modIsExported    , equivalentNameInNewMod--    -- ** Property checking-    ,isVarId,isConId,isOperator,isTopLevelPN,isLocalPN,isNonLibraryName-    ,isQualifiedPN, isFunOrPatName, isTypeSig, isTypeSigDecl-    ,isFunBindP,isFunBindR,isPatBindP,isPatBindR,isSimplePatBind,isSimplePatDecl-    ,isComplexPatBind,isComplexPatDecl,isFunOrPatBindP,isFunOrPatBindR-    ,usedWithoutQualR,isUsedInRhs--    -- ** Getting-    ,findNameInRdr-    ,findPNT,findPN,findAllNameOccurences-    ,findPNs, findNamesRdr, findEntity, findEntity'-    ,findIdForName-    ,getTypeForName--    ,defines, definesP,definesTypeSig,definesTypeSigRdr-    ,sameBind,sameBindRdr-    ,UsedByRhs(..)--    -- ** Modules and files-    -- ,clientModsAndFiles,serverModsAndFiles,isAnExistingMod-    -- ,fileNameToModName, strToModName, modNameToStr-    , isMainModule-    , getModule--    -- ** Locations-    ,defineLoc, useLoc, locToExp-    ,locToName, locToRdrName-    ,getName-- -- * Program transformation-    -- ** Adding-    ,addDecl, addItemsToImport, addItemsToExport, addHiding-    ,addParamsToDecls, addActualParamsToRhs, addImportDecl, duplicateDecl-    -- ** Removing-    ,rmDecl, rmTypeSig, rmTypeSigs -- , commentOutTypeSig, rmParams-    -- ,rmItemsFromExport, rmSubEntsFromExport, Delete(delete)--    -- ** Updating-    , rmQualifier, qualifyToplevelName, renamePN, autoRenameLocalVar--    -- ** Identifiers, expressions, patterns and declarations-    ,ghcToPN,lghcToPN, expToName, expToNameRdr-    ,nameToString-    ,patToNameRdr-    , patToPNT, pNtoPat--    -- ** Others-    , divideDecls-    , mkRdrName,mkNewGhcName,mkNewName,mkNewToplevelName--    -- The following functions are not in the the API yet.-    , causeNameClashInExports {- , inRegion , unmodified -}--    , declsSybTransform--    -- * Typed AST traversals (added by CMB)-    -- * Miscellous-    -- ,removeFromInts, getDataName, checkTypes, getPNs, getPN, getPNPats, mapASTOverTAST--    -- * Debug stuff-    , getParsedForRenamedLPat-    , getParsedForRenamedName-    , getParsedForRenamedLocated-    , rdrNameFromName-    , stripLeadingSpaces- ) where--import Control.Monad.State-import Data.Char-import Data.Foldable-import Data.List-import Data.Maybe-import Exception--import Language.Haskell.Refact.Utils.ExactPrint-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.Types-import Language.Haskell.Refact.Utils.Variables--import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.Types-import Language.Haskell.GHC.ExactPrint.Utils----- Modules from GHC-import qualified Bag           as GHC-import qualified FastString    as GHC-import qualified GHC           as GHC-import qualified Module        as GHC-import qualified Name          as GHC--- import qualified Outputable    as GHC-import qualified RdrName       as GHC-import qualified Unique        as GHC-import qualified Var           as GHC--import qualified Data.Generics as SYB-import qualified GHC.SYB.Utils as SYB--import qualified Data.Map as Map--import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero)---- ------------------------------------------------------------------------ |Process the inscope relation returned from the parsing and module--- analysis pass, and return a list of four-element tuples. Each tuple--- contains an identifier name, the identifier's namespace info, the--- identifier's defining module name and its qualifier name.------ The same identifier may have multiple entries in the result because--- it may have different qualifiers. This makes it easier to decide--- whether the identifier can be used unqualifiedly by just checking--- whether there is an entry for it with the qualifier field being--- Nothing.----inScopeInfo :: InScopes                                      -- ^ The inscope relation .-           ->[(String, GHC.NameSpace, GHC.ModuleName, Maybe GHC.ModuleName)] -- ^ The result-inScopeInfo names = nub $  map getEntInfo $ names-  where-     getEntInfo name-       =(showGhc name,-         GHC.occNameSpace $ GHC.nameOccName name,-         GHC.moduleName $ GHC.nameModule name,-         getQualMaybe $ GHC.nameRdrName name)--     getQualMaybe rdrName = case rdrName of-       GHC.Qual modName _occName -> Just modName-       _                         -> Nothing----- ------------------------------------------------------------------------- | Return True if the identifier is inscope and can be used without--- a qualifier.-isInScopeAndUnqualified::String       -- ^ The identifier name.-                       ->InScopes     -- ^ The inscope relation-                       ->Bool         -- ^ The result.-isInScopeAndUnqualified n names- = isJust $ find (\ (x, _,_, qual) -> x == n && isNothing qual ) $ inScopeInfo names---- | Return True if the identifier is inscope and can be used without--- a qualifier. The identifier name string may have a qualifier--- already--- NOTE: may require qualification based on name clash with an--- existing identifier.-isInScopeAndUnqualifiedGhc ::-     String           -- ^ The identifier name.-  -> (Maybe GHC.Name) -- ^ Existing name, to be excluded from test, if-                      --   known-  -> RefactGhc Bool   -- ^ The result.-isInScopeAndUnqualifiedGhc n maybeExising = do-  names <- ghandle handler (GHC.parseName n)-  logm $ "isInScopeAndUnqualifiedGhc:(n,(maybeExising,names))=" ++ (show n) ++ ":" ++  (showGhc (maybeExising,names))-  ctx <- GHC.getContext-  logm $ "isInScopeAndUnqualifiedGhc:ctx=" ++ (showGhc ctx)-  let nameList = case maybeExising of-                  Nothing -> names-                  Just n' -> filter (\x -> (showGhcQual x) /= (showGhcQual n')) names-  logm $ "isInScopeAndUnqualifiedGhc:(n,nameList)=" ++ (show n) ++ ":" ++  (showGhc nameList)-  return $ nameList /= []--  where-    handler:: SomeException -> RefactGhc [GHC.Name]-    handler e = do-      logm $ "isInScopeAndUnqualifiedGhc.handler e=" ++ (show e)-      return []---- ------------------------------------------------------------------------- |Return all 'GHC.Name's that correspond to the given string, in the current--- module.---- Note: this returns a list because TH constructor names do not have the--- correct namespace so the two variants are returned, constructor and--- non-constructor. I suspect that when this is looked up only one will ever--- come through. Hence we should only ever see 0 or 1 names here.-inScopeNames :: String               -- ^ The identifier name.-             -> RefactGhc [GHC.Name] -- ^ The result.-inScopeNames n = do-  names <- ghandle handler (GHC.parseName n)-  logm $ "inScopeNames:(n,names)=" ++ (show n) ++ ":" ++  (showGhc names)-  return $ names--  where-    handler:: SomeException -> RefactGhc [GHC.Name]-    handler e = do-      logm $ "inScopeNames.handler e=" ++ (show e)-      return []---- ------------------------------------------------------------------------- |Given a 'GHC.Name' defined in one module, find the equivalent one in the--- currently loaded module. This is required otherwise name equality checking--- based on 'GHC.nameUnique' will fail.-equivalentNameInNewMod :: GHC.Name -> RefactGhc [GHC.Name]-equivalentNameInNewMod old = do-  -- we have to do it this way otherwise names imported qualified will not be-  -- detected-  gnames <- GHC.getNamesInScope-  let clientModule = GHC.nameModule old-  let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames-  let newNames = filter (\n -> showGhcQual n == showGhcQual old) clientInscopes-  return newNames---- ------------------------------------------------------------------------- TODO: get rid of this-defaultName :: GHC.Name-defaultName = n-  where-    un = GHC.mkUnique 'H' 0 -- H for HaRe :)-    n = GHC.localiseName $ GHC.mkSystemName un (GHC.mkVarOcc "nothing")---- ------------------------------------------------------------------------- |Make a simple unqualified 'GHC.RdrName'-mkRdrName :: String -> GHC.RdrName-mkRdrName s = GHC.mkVarUnqual (GHC.mkFastString s)----- | Make a new GHC.Name, using the Unique Int sequence stored in the--- RefactState.-mkNewGhcName :: Maybe GHC.Module -> String -> RefactGhc GHC.Name-mkNewGhcName maybeMod name = do-  s <- get-  u <- gets rsUniqState-  put s { rsUniqState = (u+1) }-  return (mkNewGhcNamePure 'H' (u + 1) maybeMod name)----- -----------------------------------------------------------------------mkNewToplevelName :: GHC.Module -> String -> GHC.SrcSpan -> RefactGhc GHC.Name-mkNewToplevelName modid name defLoc = do-  s <- get-  u <- gets rsUniqState-  put s { rsUniqState = (u+1) }--  let un = GHC.mkUnique 'H' (u+1) -- H for HaRe :)-      n = GHC.mkExternalName un modid (GHC.mkVarOcc name) defLoc-  return n---------------------------------------------------------------------------------- |Create a new name base on the old name. Suppose the old name is 'f', then---  the new name would be like 'f_i' where 'i' is an integer.-mkNewName::String      -- ^ The old name-          ->[String]   -- ^ The set of names which the new name cannot take-          ->Int        -- ^ The posfix value-          ->String     -- ^ The result-mkNewName oldName fds suffix-  =let newName=if suffix==0 then oldName-                            else oldName++"_"++ show suffix-   in if elem newName fds-        then mkNewName oldName fds (suffix+1)-        else newName---- ------------------------------------------------------------------------- | Return True if the current module is exported either by default--- or by specifying the module name in the export.-modIsExported:: GHC.ModuleName       -- ^ The module name-               -> GHC.RenamedSource  -- ^ The AST of the module-               -> Bool               -- ^ The result-modIsExported modName (_g,_emps,mexps,_mdocs)-   = let-       modExported (GHC.L _ (GHC.IEModuleContents (GHC.L _ name))) = name == modName-       modExported _ = False--       moduleExports = filter modExported $ fromMaybe [] mexps--     in if isNothing mexps-           then True-           else (nonEmptyList moduleExports)---- ------------------------------------------------------------------------- | Return True if an identifier is exported by the module currently--- being refactored.-isExported :: GHC.Name -> RefactGhc Bool-isExported n = do-  typechecked <- getTypecheckedModule-  let modInfo = GHC.tm_checked_module_info typechecked-  return $ GHC.modInfoIsExportedName modInfo n---- ------------------------------------------------------------------------- | Return True if an identifier is explicitly exported by the module.-isExplicitlyExported::GHC.Name           -- ^ The identifier-                     ->GHC.RenamedSource -- ^ The AST of the module-                     ->Bool              -- ^ The result-isExplicitlyExported pn (_g,_imps,exps,_docs)-  = findEntity pn exps---- -------------------------------------------------------------------------- | Check if the proposed new name will conflict with an existing export-causeNameClashInExports::  GHC.Name          -- ^ The original name-                        -> GHC.Name          -- ^ The new name-                        -> GHC.ModuleName    -- ^ The identity of the module-                        -> GHC.RenamedSource -- ^ The AST of the module-                        -> Bool              -- ^ The result---- Note that in the abstract representation of exps, there is no qualified entities.-causeNameClashInExports pn newName modName renamed@(_g,imps,maybeExps,_doc)-  = let exps = fromMaybe [] maybeExps-        varExps = filter isImpVar exps-        -- TODO: make withoutQual part of the API-        withoutQual n = showGhc $ GHC.localiseName n-        modNames=nub (concatMap (\(GHC.L _ (GHC.IEVar (GHC.L _ x)))->if withoutQual x== withoutQual newName-                                                        then [GHC.moduleName $ GHC.nameModule x]-                                                        else []) varExps)-        res = (isExplicitlyExported pn renamed) &&-               ( any (modIsUnQualifedImported renamed) modNames-                 || elem modName modNames)-    in res- where-    isImpVar (GHC.L _ x) = case x of-      GHC.IEVar _ -> True-      _           -> False--    modIsUnQualifedImported _mod' modName'-     =let-      in isJust $ find (\(GHC.L _ (GHC.ImportDecl _ (GHC.L _ modName1) _qualify _source _safe isQualified _isImplicit _as _h))-                                -> modName1 == modName' && (not isQualified)) imps---- Original seems to be---   1. pick up any module names in the export list with same unQual-     --   part as the new name---   2. Check if the old is exported explicitly---   3.  if so, if the new module is exported unqualified---        or belongs to the current module---       then it will cause a clash---- ------------------------------------------------------------------------- | Given a RenamedSource LPAT, return the equivalent--- ParsedSource part.--- NOTE: returns pristine ParsedSource, since HaRe does not change it-getParsedForRenamedLPat :: GHC.ParsedSource -> GHC.LPat GHC.Name -> GHC.LPat GHC.RdrName-getParsedForRenamedLPat parsed lpatParam@(GHC.L l _pat) = r-  where-    mres = res parsed-    r = case mres of-      Just rr -> rr-      Nothing -> error $ "HaRe error: could not find Parsed LPat for"-                 ++ (SYB.showData SYB.Renamer 0 lpatParam)--    res t = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` lpat) t--    lpat :: (GHC.LPat GHC.RdrName) -> (Maybe (GHC.LPat GHC.RdrName))-    lpat p@(GHC.L lp _)-       | lp == l = Just p-    lpat _ = Nothing---- ------------------------------------------------------------------------- | Given a RenamedSource Located name, return the equivalent--- ParsedSource part.--- NOTE: returns pristine ParsedSource, since HaRe does not change it-getParsedForRenamedLocated :: ({- SYB.Typeable a, SYB.Data a, -} SYB.Typeable b {- , SYB.Data b -})-  => GHC.Located a -> RefactGhc (GHC.Located b)-getParsedForRenamedLocated (GHC.L l _n) = do-  parsed <- getRefactParsed-  let-    mres = res parsed-    r = case mres of-      Just rr -> rr-      Nothing -> error $ "HaRe error: could not find Parsed Location for"-                 ++ (showGhc l)--    res t = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` lname) t--    lname :: (GHC.Located b) -> (Maybe (GHC.Located b))-    lname p@(GHC.L lp _)-       | lp == l = Just p-    lname _ = Nothing--  return r----- | Given a RenamedSource Located name, return the equivalent--- ParsedSource part.--- NOTE: returns pristine ParsedSource, since HaRe does not change it-getParsedForRenamedName :: GHC.ParsedSource -> GHC.Located GHC.Name -> GHC.Located GHC.RdrName-getParsedForRenamedName parsed n@(GHC.L l _n) = r-  where-    mres = res parsed-    r = case mres of-      Just rr -> rr-      Nothing -> error $ "HaRe error: could not find Parsed LPat for"-                 ++ (SYB.showData SYB.Renamer 0 n)--    res t = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` lname) t--    lname :: (GHC.Located GHC.RdrName) -> (Maybe (GHC.Located GHC.RdrName))-    lname p@(GHC.L lp _)-       | lp == l = Just p-    lname _ = Nothing------------------------------------------------------------------------------ | Return True if the identifier is unqualifiedly used in the given--- syntax phrase.--- usedWithoutQualR :: GHC.Name -> GHC.ParsedSource -> Bool-usedWithoutQualR ::  (SYB.Data t) => GHC.Name -> t -> Bool-usedWithoutQualR name parsed = fromMaybe False res-  where-     res = SYB.somethingStaged SYB.Parser Nothing-            (Nothing `SYB.mkQ` worker-            `SYB.extQ` workerBind-            `SYB.extQ` workerExpr-            ) parsed--     worker  (pname :: GHC.Located GHC.RdrName) =-       checkName pname--     workerBind (GHC.L l (GHC.VarPat n) :: (GHC.Located (GHC.Pat GHC.RdrName))) =-       checkName (GHC.L l n)-     workerBind _ = Nothing--     workerExpr ((GHC.L l (GHC.HsVar n)) :: (GHC.Located (GHC.HsExpr GHC.RdrName)))-       = checkName (GHC.L l n)-     workerExpr _ = Nothing--     -- ------------------     checkName ((GHC.L l pn)::GHC.Located GHC.RdrName)-        | ((GHC.rdrNameOcc pn) == (GHC.nameOccName name)) &&-          isUsedInRhs (GHC.L l name) parsed &&-          GHC.isUnqual pn     = Just True-     checkName _ = Nothing----------------------------------------------------------------------------------getModule :: RefactGhc GHC.Module-getModule = do-  typechecked <- getTypecheckedModule-  return $ GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module typechecked---- ------------------------------------------------------------------------- | Return True if a string is a lexically  valid variable name.-isVarId :: String -> Bool-isVarId mid = isId mid && isSmall (ghead "isVarId" mid)-     where isSmall c=isLower c || c=='_'---- | Return True if a string is a lexically valid constructor name.-isConId :: String -> Bool-isConId mid = isId mid && isUpper (ghead "isConId" mid)---- | Return True if a string is a lexically valid operator name.-isOperator :: String -> Bool-isOperator mid = mid /= [] && isOpSym (ghead "isOperator" mid) &&-                isLegalOpTail (tail mid) && not (isReservedOp mid)-   where-    isOpSym mid' = elem mid' opSymbols-       where opSymbols = ['!', '#', '$', '%', '&', '*', '+','.','/','<','=','>','?','@','\'','^','|','-','~']--    isLegalOpTail tail' = all isLegal tail'-       where isLegal c = isOpSym c || c==':'--    isReservedOp mid' = elem mid' reservedOps-       where reservedOps = ["..", ":","::","=","\"", "|","<-","@","~","=>"]---- | Returns True if a string lexically is an identifier.--- *This function should not be exported.*-isId::String->Bool-isId mid = mid/=[] && isLegalIdTail (tail mid) && not (isReservedId mid)-  where-    isLegalIdTail tail' = all isLegal tail'-        where isLegal c=isSmall c|| isUpper c || isDigit c || c=='\''--    isReservedId mid' = elem mid' reservedIds-      where reservedIds=["case", "class", "data", "default", "deriving","do","else" ,"if",-                         "import", "in", "infix","infixl","infixr","instance","let","module",-                         "newtype", "of","then","type","where","_"]--    isSmall c=isLower c || c=='_'----------------------------------------------------------------------------------- |Return True if a PName is a toplevel PName.-isTopLevelPN::GHC.Name -> RefactGhc Bool-isTopLevelPN n = do-  typechecked <- getTypecheckedModule-  let maybeNames = GHC.modInfoTopLevelScope $ GHC.tm_checked_module_info typechecked-  let names = fromMaybe [] maybeNames-  return $ n `elem` names----- |Return True if a PName is a local PName.-isLocalPN::GHC.Name -> Bool-isLocalPN = GHC.isInternalName---- |Return True if the name has a @GHC.SrcSpan@, i.e. is declared in--- source we care about-isNonLibraryName :: GHC.Name -> Bool-isNonLibraryName n = case (GHC.nameSrcSpan n) of-  GHC.UnhelpfulSpan _ -> False-  _                   -> True----- |Return True if a PName is a function\/pattern name defined in t.-isFunOrPatName::(SYB.Data t) => GHC.Name -> t -> Bool-isFunOrPatName pn-   =isJust . SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` worker)-     where-        worker (decl::GHC.LHsBind GHC.Name)-           | defines pn decl = Just True-        worker _ = Nothing------------------------------------------------------------------------------------ |Return True if a PName is a qualified PName.---  AZ:NOTE: this tests the use instance, the underlying name may be qualified.---           e.g. used name is zip, GHC.List.zip---     NOTE2: not sure if this gives a meaningful result for a GHC.Name-isQualifiedPN :: GHC.Name -> RefactGhc Bool-isQualifiedPN name = return $ GHC.isQual $ GHC.nameRdrName name----- | Return True if a declaration is a type signature declaration.-isTypeSig :: GHC.LSig a -> Bool-isTypeSig (GHC.L _ (GHC.TypeSig _ _ _)) = True-isTypeSig _ = False---- | Return True if a declaration is a type signature declaration.-isTypeSigDecl :: GHC.LHsDecl a -> Bool-isTypeSigDecl (GHC.L _ (GHC.SigD (GHC.TypeSig _ _ _))) = True-isTypeSigDecl _ = False---- | Return True if a declaration is a function definition.-isFunBindP::HsDeclP -> Bool-isFunBindP (GHC.L _ (GHC.ValD (GHC.FunBind _ _ _ _ _ _))) = True-isFunBindP _ =False--isFunBindR::GHC.LHsBind t -> Bool-isFunBindR (GHC.L _l (GHC.FunBind _ _ _ _ _ _)) = True-isFunBindR _ =False---- | Returns True if a declaration is a pattern binding.-isPatBindP::HsDeclP->Bool-isPatBindP (GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _))) = True-isPatBindP _=False--isPatBindR::GHC.LHsBind t -> Bool-isPatBindR (GHC.L _ (GHC.PatBind _ _ _ _ _)) = True-isPatBindR _=False----- | Return True if a declaration is a pattern binding which only--- defines a variable value.-isSimplePatDecl :: (GHC.DataId t) => GHC.LHsDecl t-> Bool-isSimplePatDecl decl = case decl of-     (GHC.L _l (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) -> hsPNs p /= []-     _ -> False---- | Return True if a declaration is a pattern binding which only--- defines a variable value.-isSimplePatBind :: (GHC.DataId t) => GHC.LHsBind t-> Bool-isSimplePatBind decl = case decl of-     (GHC.L _l (GHC.PatBind p _rhs _ty _fvs _)) -> hsPNs p /= []-     _ -> False---- | Return True if a declaration is a pattern binding but not a simple one.-isComplexPatDecl::GHC.LHsDecl name -> Bool-isComplexPatDecl (GHC.L l (GHC.ValD decl)) = isComplexPatBind (GHC.L l decl)-isComplexPatDecl _ = False---- | Return True if a LHsBin is a pattern binding but not a simple one.-isComplexPatBind::GHC.LHsBind name -> Bool-isComplexPatBind decl-  = case decl of-     (GHC.L _l (GHC.PatBind (GHC.L _ (GHC.VarPat _)) _rhs _ty _fvs _)) -> True-     _ -> False---- | Return True if a declaration is a function\/pattern definition.-isFunOrPatBindP :: HsDeclP -> Bool-isFunOrPatBindP decl = isFunBindP decl || isPatBindP decl---- | Return True if a declaration is a function\/pattern definition.-isFunOrPatBindR :: GHC.LHsBind t -> Bool-isFunOrPatBindR decl = isFunBindR decl || isPatBindR decl---- -------------------------------------------------------------------------- | Returns True is a syntax phrase, say a, is part of another syntax--- phrase, say b.--- Expects to be at least Parser output-findEntity':: (SYB.Data a, SYB.Data b)-              => a -> b -> Maybe (SimpPos,SimpPos)-findEntity' a b = res-  where-    -- ++AZ++ do a generic traversal, and see if it matches.-    res = SYB.somethingStaged SYB.Parser Nothing worker b--    worker :: (SYB.Data c)-           => c -> Maybe (SimpPos,SimpPos)-    worker x = if SYB.typeOf a == SYB.typeOf x-                 -- then Just (getStartEndLoc b == getStartEndLoc a)-                 then Just (getStartEndLoc x)-                 else Nothing------------------------------------------------------------------------------------sameBindRdr :: NameMap -> GHC.LHsDecl GHC.RdrName -> GHC.LHsDecl GHC.RdrName -> Bool-sameBindRdr nm b1 b2 = (definedNamesRdr nm b1) == (definedNamesRdr nm b2)--sameBind :: GHC.LHsBind GHC.Name -> GHC.LHsBind GHC.Name -> Bool-sameBind b1 b2 = (definedPNs b1) == (definedPNs b2)---- ------------------------------------------------------------------------- TODO: is this the same is isUsedInRhs?-class (SYB.Data t) => UsedByRhs t where--    -- | Return True if any of the GHC.Name's appear in the given-    -- syntax element-    usedByRhs :: t -> [GHC.Name] -> Bool-    usedByRhsRdr :: NameMap -> t -> [GHC.Name] -> Bool--instance UsedByRhs GHC.RenamedSource where--   -- Not a meaningful question at this level-   usedByRhs _renamed _pns = False-   usedByRhsRdr _ _ = assert False undefined--instance UsedByRhs (GHC.HsModule GHC.RdrName) where--   -- Not a meaningful question at this level-   usedByRhsRdr _ _parsed _pns = False-   usedByRhs _ _ = assert False undefined---- ---------------------------------------instance (UsedByRhs a) => UsedByRhs (GHC.Located a) where-  usedByRhsRdr nm (GHC.L _ d) pns = usedByRhsRdr nm d pns-  -- usedByRhs _ _ = assert False undefined-  usedByRhs _ la = error $ "usedByRhs:Located a=" ++ SYB.showData SYB.Parser 0 la---- ---------------------------------------instance UsedByRhs [GHC.LHsDecl GHC.RdrName] where-  usedByRhs _ _ = assert False undefined-  usedByRhsRdr nm ds pns = or $ map (\d -> usedByRhsRdr nm d pns) ds---- ---------------------------------------instance UsedByRhs (GHC.HsDecl GHC.RdrName) where-  usedByRhs _ _ = assert False undefined-  usedByRhsRdr nm de pns =-   case de of-      GHC.TyClD d       -> f d-      GHC.InstD d       -> f d-      GHC.DerivD d      -> f d-      GHC.ValD d        -> f d-      GHC.SigD d        -> f d-      GHC.DefD d        -> f d-      GHC.ForD d        -> f d-      GHC.WarningD d    -> f d-      GHC.AnnD d        -> f d-      GHC.RuleD d       -> f d-      GHC.VectD d       -> f d-      GHC.SpliceD d     -> f d-      GHC.DocD d        -> f d-      GHC.RoleAnnotD d  -> f d-#if __GLASGOW_HASKELL__ < 711-      GHC.QuasiQuoteD d -> f d-#endif-     where-       f d' = usedByRhsRdr nm d' pns---- ---------------------------------------instance UsedByRhs (GHC.TyClDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.InstDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.DerivDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.ForeignDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.WarnDecls GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.AnnDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.RoleAnnotDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.HsQuasiQuote GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.DefaultDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.SpliceDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.VectDecl GHC.RdrName) where-  usedByRhsRdr = assert False undefined-  usedByRhs _ _ = assert False undefined--instance UsedByRhs (GHC.RuleDecls GHC.RdrName) where-  usedByRhs _ _ = assert False undefined-  usedByRhsRdr = assert False undefined--instance UsedByRhs GHC.DocDecl where-  usedByRhs _ _ = assert False undefined-  usedByRhsRdr = assert False undefined--instance UsedByRhs (GHC.Sig GHC.RdrName) where-  usedByRhsRdr _ _ _ = False-  usedByRhs _ = assert False undefined---- ---------------------------------------instance UsedByRhs (GHC.LHsBinds GHC.Name) where-  usedByRhs binds pns = or $ map (\b -> usedByRhs b pns) $ GHC.bagToList binds-  usedByRhsRdr _ _ = assert False undefined--instance UsedByRhs (GHC.HsValBinds GHC.Name) where-  usedByRhs (GHC.ValBindsIn binds _sigs) pns  = usedByRhs (GHC.bagToList binds) pns-  usedByRhs (GHC.ValBindsOut binds _sigs) pns = or $ map (\(_,b) -> usedByRhs b pns) binds-  usedByRhsRdr _ _ = assert False undefined---- ---------------------------------------instance UsedByRhs (GHC.Match GHC.Name (GHC.LHsExpr GHC.Name)) where-  usedByRhs (GHC.Match _ _ _ (GHC.GRHSs rhs _)) pns -- = usedByRhs (hsValBinds rhs) pns-                                                 = findPNs pns rhs-  usedByRhsRdr _ _ = assert False undefined---instance UsedByRhs (GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where-  usedByRhsRdr nm (GHC.Match _ _ _ (GHC.GRHSs rhs _)) pns-    = findNamesRdr nm pns rhs--  usedByRhs _ _ = assert False undefined---- ---------------------------------------instance UsedByRhs [GHC.LHsBind GHC.Name] where-  usedByRhs binds pns = or $ map (\b -> usedByRhs b pns) binds-  usedByRhsRdr _ _ = assert False undefined--instance UsedByRhs (GHC.HsBind GHC.Name) where-  usedByRhs (GHC.FunBind _ _ matches _ _ _) pns = findPNs pns matches-  usedByRhs (GHC.PatBind _ rhs _ _ _)       pns = findPNs pns rhs-  usedByRhs (GHC.VarBind _ rhs _)           pns = findPNs pns rhs-  usedByRhs (GHC.AbsBinds _ _ _ _ _)       _pns = False-  usedByRhs (GHC.PatSynBind _)             _pns = error "To implement: usedByRhs PaySynBind"-  usedByRhsRdr _ _ = assert False undefined---- ---------------------------------------instance UsedByRhs (GHC.HsBind GHC.RdrName) where-  usedByRhs _ _ = assert False undefined-  usedByRhsRdr nm  (GHC.FunBind _ _ matches _ _ _)        pns = findNamesRdr nm pns matches-  usedByRhsRdr nm  (GHC.PatBind _ rhs _ _ _)              pns = findNamesRdr nm pns rhs-  usedByRhsRdr nm  (GHC.PatSynBind (GHC.PSB _ _ _ rhs _)) pns = findNamesRdr nm pns rhs-  usedByRhsRdr nm  (GHC.VarBind _ rhs _)                  pns = findNamesRdr nm pns rhs-  usedByRhsRdr _nm (GHC.AbsBinds _ _ _ _ _)              _pns = False---- ---------------------------------------instance UsedByRhs (GHC.HsExpr GHC.Name) where-  usedByRhs (GHC.HsLet _lb e) pns = findPNs pns e-  usedByRhs e                _pns = error $ "undefined usedByRhs:" ++ (showGhc e)-  usedByRhsRdr _ _ = assert False undefined--instance UsedByRhs (GHC.HsExpr GHC.RdrName) where-  usedByRhsRdr nm (GHC.HsLet _lb e) pns = findNamesRdr nm pns e-  usedByRhsRdr _ e                 _pns = error $ "undefined usedByRhsRdr:" ++ (showGhc e)-  usedByRhs _ _ = assert False undefined---- ---------------------------------------instance UsedByRhs (GHC.Stmt GHC.Name (GHC.LHsExpr GHC.Name)) where-  usedByRhs (GHC.LetStmt lb) pns = findPNs pns lb-  usedByRhs s               _pns = error $ "undefined usedByRhs:" ++ (showGhc s)-  usedByRhsRdr _ _ = assert False undefined--instance UsedByRhs (GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where-  usedByRhsRdr nm (GHC.LetStmt lb) pns = findNamesRdr nm pns lb-  usedByRhsRdr _ s               _pns = error $ "undefined usedByRhsRdr:" ++ (showGhc s)-  usedByRhs _ _ = assert False undefined-------------------------------------------------------------------------------------- |Find the identifier with the given name. This looks through the--- given syntax phrase for the first GHC.Name which matches. Because--- it is Renamed source, the GHC.Name will include its defining--- location. Returns Nothing if the name is not found.--getName::(SYB.Data t)=> String           -- ^ The name to find-                     -> t                -- ^ The syntax phrase-                     -> Maybe GHC.Name   -- ^ The result-getName str t-  = res-       where-        res = SYB.somethingStaged SYB.Renamer Nothing-            (Nothing `SYB.mkQ` worker `SYB.extQ` workerBind `SYB.extQ` workerExpr) t--        worker ((GHC.L _ n) :: (GHC.Located GHC.Name))-          | showGhcQual n == str = Just n-        worker _ = Nothing--        workerBind (GHC.L _ (GHC.VarPat name) :: (GHC.Located (GHC.Pat GHC.Name)))-          | showGhcQual name == str = Just name-        workerBind _ = Nothing---        workerExpr ((GHC.L _ (GHC.HsVar name)) :: (GHC.Located (GHC.HsExpr GHC.Name)))-          | showGhcQual name == str = Just name-        workerExpr _ = Nothing---- ------------------------------------------------------------------------- | Add identifiers to the export list of a module. If the second argument is--- like: Just p, then do the adding only if p occurs in the export list, and the--- new identifiers are added right after p in the export list. Otherwise the new--- identifiers are add to the beginning of the export list. In the case that the--- export list is emport, then if the third argument is True, then create an--- explict export list to contain only the new identifiers, otherwise do--- nothing.--addImportDecl ::-    GHC.ParsedSource-    -> GHC.ModuleName-    -> Maybe GHC.FastString -- ^qualifier-    -> Bool -> Bool -> Bool-    -> Maybe String         -- ^alias-    -> Bool-    -> [GHC.RdrName]-    -> RefactGhc GHC.ParsedSource--- addImportDecl (groupedDecls,imp, b, c) modName pkgQual source safe qualify alias hide idNames-addImportDecl (GHC.L l p) modName pkgQual source safe qualify alias hide idNames-  = do-       let imp = GHC.hsmodImports p-       impDecl <- mkImpDecl-       newSpan <- liftT uniqueSrcSpanT-       let newImp = GHC.L newSpan impDecl-       liftT $ addSimpleAnnT newImp (DP (1,0)) [((G GHC.AnnImport),DP (0,0))]-       return (GHC.L l p { GHC.hsmodImports = (imp++[newImp])})-  where--     alias' = case alias of-                  Just stringName -> Just $ GHC.mkModuleName stringName-                  _               -> Nothing--     mkImpDecl = do-       newSpan1 <- liftT uniqueSrcSpanT-       newSpan2 <- liftT uniqueSrcSpanT-       newEnts <- mkNewEntList idNames-       let lNewEnts = GHC.L newSpan2 newEnts-       -- logm $ "addImportDecl.mkImpDecl:adding anns for:" ++ showGhc lNewEnts-       liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]-       let lmodname = GHC.L newSpan1 modName-       liftT $ addSimpleAnnT lmodname (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]-       return $ GHC.ImportDecl-                        { GHC.ideclSourceSrc = Nothing-                        , GHC.ideclName      = lmodname-                        , GHC.ideclPkgQual   = pkgQual-                        , GHC.ideclSource    = source-                        , GHC.ideclSafe      = safe-                        , GHC.ideclQualified = qualify-                        , GHC.ideclImplicit  = False-                        , GHC.ideclAs        = alias'-                        , GHC.ideclHiding    =-                                      (if idNames == [] && hide == False then-                                            Nothing-                                       else-                                            (Just (hide, lNewEnts)))-                        }---- ------------------------------------------------------------------------- | Adding a declaration to the declaration list of the given syntax--- phrase. If the second argument is Nothing, then the declaration--- will be added to the beginning of the declaration list, but after--- the data type declarations is there is any.-addDecl:: (SYB.Data t,SYB.Typeable t)-        => t              -- ^The AST to be updated-        -> Maybe GHC.Name -- ^If this is Just, then the declaration-                          -- will be added right after this-                          -- identifier's definition.-        -> ([GHC.LHsDecl GHC.RdrName],  Maybe Anns)-             -- ^ The declaration with optional signatures to be added, together-             -- with optional Annotations.-        -> RefactGhc t--addDecl parent pn (declSig, mDeclAnns) = do-  logm $ "addDecl:declSig=" ++ showGhc declSig-  case mDeclAnns of-    Nothing -> return ()-    Just declAnns -> -- addRefactAnns declAnns-      liftT $ modifyAnnsT (mergeAnns declAnns)-  case pn of-    Just pn' -> appendDecl   parent pn' declSig-    Nothing  -> addLocalDecl parent     declSig- where-  setDeclSpacing newDeclSig n c = do-    -- First clear any previous indentation-    mapM_ (\d -> setPrecedingLinesDeclT d 1 0) newDeclSig-    setPrecedingLinesT (ghead "addDecl" newDeclSig) n c-    -- mapM_ (\d -> setPrecedingLinesT d 1 0) (gtail "addDecl" newDeclSig)--  appendDecl :: (SYB.Data t)-      => t        -- ^Original AST-      -> GHC.Name -- ^Name to add the declaration after-      -> [GHC.LHsDecl GHC.RdrName] -- ^declaration and maybe sig-      -> RefactGhc t -- ^updated AST-  appendDecl parent1 pn' newDeclSig = do-    hasDeclsSybTransform workerHsDecls workerBind parent1-    where-      workerHsDecls :: forall t. HasDecls t => t -> RefactGhc t-      workerHsDecls parent' = do-        -- logm $ "addDecl.appendDecl:(pn')=" ++ showGhc pn'-        liftT $ setDeclSpacing newDeclSig 2 0-        nameMap <- getRefactNameMap-        decls <- liftT $ hsDecls parent'-        let-           (before,after) = break (definesDeclRdr nameMap pn') decls--        -- logm $ "addDecl.appendDecl:(before,after)=" ++ showGhc (before,after)-        let (decls1,decls2) = case after of-              [] -> (before,[])-              _  -> (before ++ [ghead "appendDecl14" after],-                     gtail "appendDecl15" after)-        liftT $ replaceDecls parent' (decls1++newDeclSig++decls2)--      workerBind :: (GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName))-      workerBind = assert False undefined--  addLocalDecl :: (SYB.Typeable t,SYB.Data t)-               => t -> [GHC.LHsDecl GHC.RdrName]-               -> RefactGhc t-  addLocalDecl parent' newDeclSig = do-    logm $ "addLocalDecl entered"-    -- logDataWithAnns "addLocalDecl.parent'" parent'-    hasDeclsSybTransform workerHasDecls workerBind parent'-    where-      workerDecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]-      workerDecls decls = do-         logm $ "workerDecls entered"-         case decls of-           [] -> liftT $ setDeclSpacing newDeclSig 2 0-           ds -> do-             DP (r,c) <- liftT (getEntryDPT (head ds))-             liftT $ setDeclSpacing newDeclSig r c-             liftT $ setPrecedingLinesT (head ds) 2 0-         return (newDeclSig++decls)--      workerHasDecls :: (HasDecls t) => t -> RefactGhc t-      workerHasDecls p = do-         logm $ "workerHasDecls entered"-         decls <- liftT (hsDecls p)-         decls' <- workerDecls decls-         r <- liftT $ replaceDecls p decls'-         return r--      workerBind :: GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName)-      workerBind b = do-        logm $ "workerBind entered"-        case b of-          GHC.L l (GHC.FunBind n i (GHC.MG [match] a ptt o) co fvs t) -> do-            match' <- workerHasDecls match-            return (GHC.L l (GHC.FunBind n i (GHC.MG [match'] a ptt o) co fvs t))-          GHC.L _ (GHC.FunBind _ _ (GHC.MG _matches _ _ _) _ _ _) -> do-            error "addDecl:Cannot add a local decl to a FunBind with multiple matches"-          p@(GHC.L _ (GHC.PatBind _pat _rhs _ty _fvs _t)) -> do-            logm $ "workerBind.PatBind entered"-            decls <- liftT (hsDeclsPatBind p)-            decls' <- workerDecls decls-            r <- liftT $ replaceDeclsPatBind p decls'-            return r--          x -> error $ "addLocalDecl.workerBind:not processing:" ++ SYB.showData SYB.Parser 0 x---- --------------------------------------------------------------------------- -----------------------------------------------------------------------rdrNameFromName :: Bool -> GHC.Name -> RefactGhc GHC.RdrName-rdrNameFromName useQual newName = do-  mname <- case (GHC.nameModule_maybe newName) of-      Just (GHC.Module _ mn) -> return mn-      Nothing -> do-        GHC.Module _ mn <- getRefactModule-        return mn--  if useQual-    then return $ GHC.mkRdrQual mname (GHC.nameOccName newName)-    else return $ GHC.mkRdrUnqual     (GHC.nameOccName newName)---- ------------------------------------------------------------------------- |Take a list of strings and return a list with the longest prefix--- of spaces removed-stripLeadingSpaces :: [String] -> [String]-stripLeadingSpaces xs = map (drop n) xs-  where-    n = minimum $ map oneLen xs--    oneLen x = length prefix-      where-        (prefix,_) = break (/=' ') x---- ------------------------------------------------------------------------- | add items to the hiding list of an import declaration which--- imports the specified module.-addHiding::-     GHC.ModuleName       -- ^ The imported module name-  -> GHC.ParsedSource     -- ^ The current module-  -> [GHC.RdrName]        -- ^ The items to be added-  -> RefactGhc GHC.ParsedSource -- ^ The result-addHiding mn p ns = do-  logm $ "addHiding called for (module,names):" ++ showGhc (mn,ns)-  p' <- addItemsToImport' mn p ns Hide-  putRefactParsed p' emptyAnns-  return p'---- ------------------------------------------------------------------------ | Creates a new entity list for hiding a name in an ImportDecl.-mkNewEntList :: [GHC.RdrName] -> RefactGhc [GHC.LIE GHC.RdrName]-mkNewEntList idNames = do-  case idNames of-    [] -> return []-    _ -> do-      newEntsInit <- mapM (mkNewEnt True) (init idNames)-      newEntsLast <- mkNewEnt False (last idNames)-      return (newEntsInit ++ [newEntsLast])---- | Creates a new entity for hiding a name in an ImportDecl.-mkNewEnt :: Bool -> GHC.RdrName -> RefactGhc (GHC.LIE GHC.RdrName)-mkNewEnt addCommaAnn pn = do-  newSpan <- liftT uniqueSrcSpanT-  let lpn = GHC.L newSpan pn-  if addCommaAnn-    then liftT $ addSimpleAnnT lpn (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]-    else liftT $ addSimpleAnnT lpn (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]-  return (GHC.L newSpan (GHC.IEVar lpn))---- | Represents the operation type we want to select on addItemsToImport'-data ImportType = Hide     -- ^ Used for addHiding-                | Import   -- ^ Used for addItemsToImport---- | Add identifiers (given by the third argument) to the explicit entity list in the declaration importing the---   specified module name. This function does nothing if the import declaration does not have an explicit entity list.-addItemsToImport::-    GHC.ModuleName       -- ^ The imported module name-  ->GHC.ParsedSource     -- ^ The current module-  ->[GHC.RdrName]        -- ^ The items to be added---  ->Maybe GHC.Name       -- ^ The condition identifier.-  ->RefactGhc GHC.ParsedSource -- ^ The result-addItemsToImport mn r ns = addItemsToImport' mn r ns Import---- | Add identifiers (given by the third argument) to the explicit entity list in the declaration importing the---   specified module name. If the ImportType argument is Hide, then the items will be added to the "hiding"---   list. If it is Import, they will be added to the explicit import entries. This function does nothing if---   the import declaration does not have an explicit entity list and ImportType is Import.-addItemsToImport'::-     GHC.ModuleName       -- ^ The imported module name-  -> GHC.ParsedSource     -- ^ The current module-  -> [GHC.RdrName]        -- ^ The items to be added---  ->Maybe GHC.Name       -- ^ The condition identifier.-  -> ImportType           -- ^ Whether to hide the names or import them. Uses special data for clarity.-  -> RefactGhc GHC.ParsedSource -- ^ The result-addItemsToImport' serverModName (GHC.L l p) pns impType = do-    let imps = GHC.hsmodImports p-    imps' <- mapM inImport imps-    return $ GHC.L l p {GHC.hsmodImports = imps'}-  where-    isHide = case impType of-             Hide   -> True-             Import -> False--    inImport :: GHC.LImportDecl GHC.RdrName -> RefactGhc (GHC.LImportDecl GHC.RdrName)-    inImport imp@(GHC.L _ (GHC.ImportDecl _st (GHC.L _ modName) _qualify _source _safe isQualified _isImplicit _as h))-      | serverModName == modName  && not isQualified -- && (if isJust pn then findPN (gfromJust "addItemsToImport" pn) h else True)-       = case h of-           Nothing                          -> insertEnts imp []   True-           Just (_isHide, (GHC.L _le ents)) -> insertEnts imp ents False-    inImport x = return x--    insertEnts ::-      GHC.LImportDecl GHC.RdrName-      -> [GHC.LIE GHC.RdrName]-      -> Bool -- True means there are already existing entities-      -> RefactGhc ( GHC.LImportDecl GHC.RdrName )-    insertEnts imp ents isNew = do-        logm $ "addItemsToImport':insertEnts:(imp,ents,isNew):" ++ showGhc (imp,ents,isNew)-        if isNew && not isHide then return imp-         else do-            logm $ "addItemsToImport':insertEnts:doing stuff"-            newSpan <- liftT uniqueSrcSpanT-            newEnts <- mkNewEntList pns-            let lNewEnts = GHC.L newSpan (ents++newEnts)-            logm $ "addImportDecl.mkImpDecl:adding anns for:" ++ showGhc lNewEnts-            if isHide-              then-                liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]-              else-                liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnOpenP),DP (0,0)),((G GHC.AnnCloseP),DP (0,0))]-            when (not (null ents)) $ do liftT (addTrailingCommaT (last ents))-            return (replaceHiding imp  (Just (isHide, lNewEnts)))---    replaceHiding (GHC.L l1 (GHC.ImportDecl st mn q src safe isQ isImp as _h)) h1 =-                  (GHC.L l1 (GHC.ImportDecl st mn q src safe isQ isImp as h1))---- -----------------------------------------------------------------------addParamsToDecls::-        [GHC.LHsDecl GHC.RdrName] -- ^ A declaration list where the function is defined and\/or used.-      -> GHC.Name       -- ^ The function name.-      -> [GHC.RdrName]  -- ^ The parameters to be added.-      -> RefactGhc [GHC.LHsDecl GHC.RdrName] -- ^ The result.--addParamsToDecls decls pn paramPNames = do-  -- logm $ "addParamsToDecls (pn,paramPNames,modifyToks)=" ++ (showGhc (pn,paramPNames,modifyToks))-  nameMap <- getRefactNameMap-  if (paramPNames /= [])-        then mapM (addParamToDecl nameMap) decls-        else return decls-  where-   addParamToDecl :: NameMap -> GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)-   addParamToDecl nameMap (GHC.L l1 (GHC.ValD (GHC.FunBind lp@(GHC.L l2 pname) i (GHC.MG matches a ptt o) co fvs t)))-    | eqRdrNamePure nameMap lp pn-    = do-         matches' <- mapM addParamtoMatch matches-         return (GHC.L l1 (GHC.ValD (GHC.FunBind (GHC.L l2 pname) i (GHC.MG matches' a ptt o) co fvs t)))-      where-       addParamtoMatch (GHC.L l (GHC.Match fn1 pats mtyp rhs))-        = do-             rhs' <- addActualParamsToRhs pn paramPNames rhs-             pats' <- liftT $ mapM addParam paramPNames-             return (GHC.L l (GHC.Match fn1 (pats'++pats) mtyp rhs'))--   -- TODO: The following will never match, as a PatBind only deals with complex patterns.-   addParamToDecl _nameMap x@(GHC.L _l1 (GHC.ValD (GHC.PatBind _pat@(GHC.L _l2 (GHC.VarPat _p)) _rhs _ty _fvs _t)))-     = return x-   addParamToDecl _ x = return x--   addParam n = do-     newSpan <- uniqueSrcSpanT-     let vn = (GHC.L newSpan (pNtoPat n))-     addSimpleAnnT vn (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]-     return vn---- -----------------------------------------------------------------------addItemsToExport ::-                    GHC.ParsedSource                    -- The module AST.-                   -> Maybe PName                       -- The condtion identifier.-                   -> Bool                              -- Create an explicit list or not-                   -> Either [String] [GHC.LIE GHC.RdrName] -- The identifiers to add in either String or HsExportEntP format.-                   -> RefactGhc GHC.ParsedSource        -- The result.-addItemsToExport = assert False undefined-{----- | Add identifiers to the export list of a module. If the second argument is like: Just p, then do the adding only if p occurs--- in the export list, and the new identifiers are added right after p in the export list. Otherwise the new identifiers are add--- to the beginning of the export list. In the case that the export list is emport, then if the third argument is True, then create--- an explict export list to contain only the new identifiers, otherwise do nothing.-{--addItemsToExport::( )-                 => HsModuleP                           -- The module AST.-                   -> Maybe PName                       -- The condtion identifier.-                   -> Bool                              -- Create an explicit list or not-                   -> Either [String] [HsExportEntP]    -- The identifiers to add in either String or HsExportEntP format.-                   -> m HsModuleP                       -- The result.--}--addItemsToExport::(MonadState (([PosToken],Bool), t1) m)-                 => HsModuleP                           -- The module AST.-                   -> Maybe PName                       -- The condtion identifier.-                   -> Bool                              -- Create an explicit list or not-                   -> Either [String] [HsExportEntP]    -- The identifiers to add in either String or HsExportEntP format.-                   -> m HsModuleP                       -- The result.---addItemsToExport mod _  _ (Left [])  = return mod-addItemsToExport mod _  _ (Right []) = return mod-addItemsToExport mod@(HsModule loc modName exps imps ds) (Just pn) _ ids-  =  case exps  of-       Just ents ->let (e1,e2) = break (findEntity pn) ents-                   in if e2 /=[]-                        then do ((toks,_),others)<-get-                                let e = (ghead "addVarItemInExport" e2)-                                    es = case ids of-                                          (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'-                                          (Right es') -> es'-                                let (_,endPos) = getStartEndLoc toks e-                                    (t, (_,s)) = ghead "addVarItemInExport" $ getToks (endPos,endPos) toks-                                    newToken = mkToken t endPos (s++","++ showEntities (render.ppi) es)-                                    toks' = replaceToks toks endPos endPos [newToken]-                                put ((toks',modified),others)-                                return (HsModule loc modName (Just (e1++(e:es)++tail e2)) imps ds)-                        else return mod-       Nothing   -> return mod--addItemsToExport mod@(HsModule _ _ (Just ents) _ _) Nothing createExp ids-    = do ((toks,_),others)<-get-         let es = case ids of-                    (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'-                    (Right es') -> es'-             (t, (pos,s))=fromJust $ find isOpenBracket toks  -- s is the '('-             newToken = if ents /=[] then  (t, (pos,(s++showEntities (render.ppi) es++",")))-                                     else  (t, (pos,(s++showEntities (render.ppi) es)))-             pos'= simpPos pos-             toks' = replaceToks toks pos' pos' [newToken]-         put ((toks',modified),others)-         return mod {hsModExports=Just (es++ ents)}--addItemsToExport mod@(HsModule _  (SN modName (SrcLoc _ c row col))  Nothing _ _)  Nothing createExp ids-  =case createExp of-       True ->do ((toks,_),others)<-get-                 let es = case ids of-                               (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'-                               (Right es') -> es'-                     pos = (row,col)-                     newToken = mkToken Varid pos (modNameToStr modName++ "("-                                         ++ showEntities (render.ppi) es++")")-                     toks' = replaceToks toks pos pos [newToken]-                 put  ((toks', modified), others)-                 return mod {hsModExports=Just es}-       False ->return mod---}--- -----------------------------------------------------------------------addActualParamsToRhs :: (SYB.Data t) =>-                        GHC.Name -> [GHC.RdrName] -> t -> RefactGhc t-addActualParamsToRhs pn paramPNames rhs = do-    logm $ "addActualParamsToRhs:entered:(pn,paramPNames)=" ++ showGhc (pn,paramPNames)-    nameMap <- getRefactNameMap-    let-       worker :: (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LHsExpr GHC.RdrName)-       worker oldExp@(GHC.L l2 (GHC.HsVar pname))-        | eqRdrNamePure nameMap (GHC.L l2 pname) pn-          = do-              logDataWithAnns "addActualParamsToRhs:oldExp=" oldExp-              newExp' <- liftT $ foldlM addParamToExp oldExp paramPNames--              edp <- liftT $ getEntryDPT oldExp-              liftT $ setEntryDPT oldExp (DP (0,0))-              l2' <- liftT $ uniqueSrcSpanT-              let newExp  = (GHC.L l2' (GHC.HsPar newExp'))-              liftT $ addSimpleAnnT newExp (DP (0,0)) [(G GHC.AnnOpenP,DP (0,0)),(G GHC.AnnCloseP,DP (0,0))]-              liftT $ setEntryDPT newExp edp-              return newExp-       worker x = return x--       addParamToExp :: (GHC.LHsExpr GHC.RdrName) -> GHC.RdrName -> Transform (GHC.LHsExpr GHC.RdrName)-       addParamToExp expr param = do-         ss1 <- uniqueSrcSpanT-         ss2 <- uniqueSrcSpanT-         let var   = GHC.L ss2 (GHC.HsVar param)-         let expr' = GHC.L ss1 (GHC.HsApp expr var)-         addSimpleAnnT var (DP (0,0)) [(G GHC.AnnVal,DP (0,1))]-         addSimpleAnnT expr' (DP (0,0)) []-         return expr'--    r <- applyTP (full_buTP (idTP  `adhocTP` worker)) rhs-    return r--{---The code--    sumSqu (x:xs) = (sq bar2) x + sumSquares xs--results in--          (GRHSs -           [-            ({ LiftToToplevel/D1.hs:(13,15)-(15,16) }-             Just (Ann (DP (0,-1)) [] [] [] Nothing Nothing)-             (GRHS -              [] -              ({ LiftToToplevel/D1.hs:13:17-43 }-               Just (Ann (DP (0,1)) [] [] [] Nothing Nothing)-               (OpApp -                ({ LiftToToplevel/D1.hs:13:17-27 }-                 Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)-                 (HsApp -                  ({ LiftToToplevel/D1.hs:13:17-25 }-                   Just (Ann (DP (0,0)) [] [] [((G AnnOpenP),DP (0,0)),((G AnnCloseP),DP (0,0))] Nothing Nothing)-                   (HsPar -                    ({ LiftToToplevel/D1.hs:13:18-24 }-                     Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)-                     (HsApp -                      ({ LiftToToplevel/D1.hs:13:18-19 }-                       Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                       (HsVar -                        (Unqual {OccName: sq}))) -                      ({ LiftToToplevel/D1.hs:13:21-24 }-                       Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                       (HsVar -                        (Unqual {OccName: bar2}))))))) -                  ({ LiftToToplevel/D1.hs:13:27 }-                   Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                   (HsVar -                    (Unqual {OccName: x}))))) -                ({ LiftToToplevel/D1.hs:13:29 }-                 Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                 (HsVar -                  (Unqual {OccName: +}))) -                (PlaceHolder) -                ({ LiftToToplevel/D1.hs:13:31-43 }-                 Just (Ann (DP (0,1)) [] [] [] Nothing Nothing)-                 (HsApp -                  ({ LiftToToplevel/D1.hs:13:31-40 }-                   Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                   (HsVar -                    (Unqual {OccName: sumSquares}))) -                  ({ LiftToToplevel/D1.hs:13:42-43 }-                   Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)-                   (HsVar -                    (Unqual {OccName: xs})))))))))] ---}-{--Required end result : (sq pow) x + sumSquares xs--                (L {test/testdata/LiftToToplevel/D2.hs:6:21-46}-                 (OpApp--                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-30}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-28}-                     (HsPar-                      (L {test/testdata/LiftToToplevel/D2.hs:6:22-27}-                       (HsApp-                        (L {test/testdata/LiftToToplevel/D2.hs:6:22-23}-                         (HsVar {Name: LiftToToplevel.D2.sq}))-                        (L {test/testdata/LiftToToplevel/D2.hs:6:25-27}-                         (HsVar {Name: pow}))))))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:30}-                     (HsVar {Name: x}))))--                  (L {test/testdata/LiftToToplevel/D2.hs:6:32}-                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}-                  (L {test/testdata/LiftToToplevel/D2.hs:6:34-46}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:34-43}-                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:45-46}-                     (HsVar {Name: xs}))))))))]--Alternate, no parens : sq pow x + sumSquares xs--                (L {test/testdata/LiftToToplevel/D2.hs:6:21-44}-                 (OpApp--                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-28}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-26}-                     (HsApp-                      (L {test/testdata/LiftToToplevel/D2.hs:6:21-22}-                       (HsVar {Name: LiftToToplevel.D2.sq}))-                      (L {test/testdata/LiftToToplevel/D2.hs:6:24-26}-                       (HsVar {Name: pow}))))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:28}-                     (HsVar {Name: x}))))---                  (L {test/testdata/LiftToToplevel/D2.hs:6:30}-                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}-                  (L {test/testdata/LiftToToplevel/D2.hs:6:32-44}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:32-41}-                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:43-44}-                     (HsVar {Name: xs}))))))))]---Original : sq x + sumSquares xs--                (L {test/testdata/LiftToToplevel/D2.hs:6:21-40}-                 (OpApp--                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-24}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-22}-                     (HsVar {Name: sq}))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:24}-                     (HsVar {Name: x}))))---                  (L {test/testdata/LiftToToplevel/D2.hs:6:26}-                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}-                  (L {test/testdata/LiftToToplevel/D2.hs:6:28-40}-                   (HsApp-                    (L {test/testdata/LiftToToplevel/D2.hs:6:28-37}-                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))-                    (L {test/testdata/LiftToToplevel/D2.hs:6:39-40}-                     (HsVar {Name: xs}))))))))]---}---- ------------------------------------------------------------------------- | Duplicate a function\/pattern binding declaration under a new name--- right after the original one.-duplicateDecl ::-    [GHC.LHsDecl GHC.RdrName] -- ^ decls to be updated, containing the original decl (and sig)-  ->GHC.Name            -- ^ The identifier whose definition is to be duplicated-  ->GHC.Name            -- ^ The new name (possibly qualified)-  ->RefactGhc [GHC.LHsDecl GHC.RdrName]  -- ^ The result-duplicateDecl decls n newFunName- = do-     logm $ "duplicateDecl entered:(decls,n,newFunName)=" ++ showGhc (decls,n,newFunName)-     nm <- getRefactNameMap-     let-       declsToDup = definingDeclsRdrNames nm [n] decls True False-       funBinding = filter isFunOrPatBindP declsToDup     --get the fun binding.-       typeSig    = map wrapSig $ definingSigsRdrNames nm [n] decls-     funBinding'' <- renamePN n newFunName False funBinding-     typeSig'' <- renamePN n newFunName False typeSig-     logm $ "duplicateDecl:funBinding''=" ++ showGhc funBinding''--     funBinding3 <- mapM (\f@(GHC.L _ fb) -> do-                             newSpan <- liftT uniqueSrcSpanT-                             let fb' = GHC.L newSpan fb-                             liftT $ modifyAnnsT (copyAnn f fb')-                             return fb'-                             ) (typeSig'' ++ funBinding'')-     when (not $ null funBinding3) $ do-                             liftT $ setEntryDPT (head funBinding3) (DP (2,0))-                             liftT $ mapM_ (\d -> setEntryDPT d (DP (1,0))) (tail funBinding3)-     let (decls1,decls2) = break (definesDeclRdr nm n) decls-         (declsToDup',declsRest) = break (not . definesDeclRdr nm n) decls2-     -- logDataWithAnns "duplicateDecl:funBinding3" funBinding3-     return $ decls1 ++ declsToDup' ++ funBinding3 ++ declsRest---- ------------------------------------------------------------------------ |Divide a declaration list into three parts (before, parent, after)--- according to the PNT, where 'parent' is the first decl containing--- the PNT, 'before' are those decls before 'parent' and 'after' are--- those decls after 'parent'.--divideDecls :: SYB.Data t =>-  [t] -> GHC.Located GHC.Name -> RefactGhc ([t], [t], [t])-divideDecls ds (GHC.L _ pnt) = do-  nm <- getRefactNameMap-  let (before,after) = break (\x -> findNameInRdr nm pnt x) ds-  return $ if (not $ emptyList after)-         then (before, [ghead "divideDecls" after], gtail "divideDecls" after)-         else (ds,[],[])---- ------------------------------------------------------------------------- | Remove the declaration (and the type signature is the second--- parameter is True) that defines the given identifier from the--- declaration list.-rmDecl:: (SYB.Data t)-    => GHC.Name     -- ^ The identifier whose definition is to be removed.-    -> Bool         -- ^ True means including the type signature.-    -> t            -- ^ The AST fragment containting the declarations,-                    -- originating from the ParsedSource-    -> RefactGhc-        (t,-        GHC.LHsDecl GHC.RdrName,-        Maybe (GHC.LSig GHC.RdrName))  -- ^ The result and the removed declaration-                                       -- and the possibly removed siganture--rmDecl pn incSig t = do-  setStateStorage StorageNone-  t' <- everywhereMStaged' SYB.Parser (SYB.mkM   inModule-                                      `SYB.extM` inLet-                                      `SYB.extM` inMatch-                                      ) t -- top down-         -- applyTP (once_tdTP (failTP `adhocTP` inBinds)) t-  storage <- getStateStorage-  let decl' = case storage of-                StorageDeclRdr decl -> decl-                x                   -> error $ "rmDecl: unexpected value in StateStorage:" ++ (show x)-  setStateStorage StorageNone-  (t'',sig') <- if incSig-                  then rmTypeSig pn t'-                  else return (t', Nothing)-  return (t'',decl',sig')-  where-    inModule (p :: GHC.ParsedSource)-      = doRmDeclList p--    inMatch x@(((GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))):: (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)))-      = doRmDeclList x--    inLet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)-    inLet letExpr@(GHC.L _ (GHC.HsLet _localDecls expr))-      = do-         isDone <- getDone-         if isDone-           then return letExpr-           else do-             nameMap <- getRefactNameMap-             -- decls <- liftT $ hsDecls localDecls-             decls <- liftT $ hsDecls letExpr-             let (decls1,decls2) = break (definesDeclRdr nameMap pn) decls-             if not $ emptyList decls2-                then do-                  let decl = ghead "rmDecl" decls2-                  setStateStorage (StorageDeclRdr decl)-                  case length decls of-                    1 -> do -- Removing the last declaration-                     return expr-                    _ -> do-                     -- logm $ "rmDecl.inLet:length decls /= 1"-                     decls' <- doRmDecl decls1 decls2-                     letExpr' <- liftT $ replaceDecls letExpr decls'-                     return letExpr'-                else do-                  -- liftT $ replaceDecls localDecls decls-                  return letExpr-    inLet x = return x--    -- -----------------------------------    doRmDeclList parent-      = do-         isDone <- getDone-         -- logm $ "doRmDeclList:isDone=" ++ show isDone-         -- logm $ "doRmDeclList:parent=" ++ SYB.showData SYB.Parser 0 parent-         if isDone-           then return parent-           else do-             nameMap <- getRefactNameMap-             decls <- liftT $ hsDecls parent-             let (decls1,decls2) = break (definesDeclRdr nameMap pn) decls-             if not $ emptyList decls2-               then do-                 -- logDataWithAnns "doRmDeclList:(parent)" (parent)-                 let decl = ghead "doRmDeclList" decls2-                 setStateStorage (StorageDeclRdr decl)-                 decls'  <- doRmDecl decls1 decls2-                 parent' <- liftT $ replaceDecls parent decls'-                 -- logDataWithAnns "doRmDeclList:(parent')" (parent')-                 return parent'-               else do-                 return parent--    -- -----------------------------------    getDone = do-      s <- getStateStorage-      case s of-        StorageNone -> return False-        _           -> return True---- ------------------------------------------------------------------------- ++AZ++ TODO: I think this has been superseded by hasDeclsSybTransform-declsSybTransform :: (SYB.Typeable a)-  => (forall b. HasDecls b => b -> RefactGhc b)-  -> a -> RefactGhc a-declsSybTransform transform = mt-  where-    mt = SYB.mkM inMatch-         `SYB.extM` inPatDecl-         `SYB.extM` inModule-         `SYB.extM` inHsLet--    inModule :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource-    inModule (modu :: GHC.ParsedSource)-       = transform modu--    inMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))-    inMatch x@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))-       = transform x--    inPatDecl ::GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)-    inPatDecl x@(GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _)))-       -- = transform x-       = error $ "declsSybTransform:need to reimplement PatBind case"-    inPatDecl x = return x--    inHsLet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)-    inHsLet x@(GHC.L _ (GHC.HsLet{}))-       = transform x-    inHsLet x = return x-- ------------------------------------------------------------------------- |Utility function to remove a decl from the middle of a list, assuming the--- list has already been split into a (possibly empty) front before the decl,--- and a back where the head is the decl to be removed.-doRmDecl :: [GHC.LHsDecl GHC.RdrName] -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]-doRmDecl decls1 decls2-  = do-      let decls2'      = gtail "doRmDecl 1" decls2-          declToRemove = head decls2--      -- logDataWithAnns "doRmDecl:(decls1,decls2)" (decls1,decls2)-      unless (null decls1)  $ do liftT $ balanceComments (last decls1) declToRemove-      unless (null decls2') $ do liftT $ balanceComments declToRemove  (head decls2')--      when (not (null decls2') && null decls1) $ do liftT $ transferEntryDPT declToRemove (head decls2')-      when (not (null decls2') && not (null decls1) && not (isTypeSigDecl (last decls1)))-        $ do liftT $ transferEntryDPT declToRemove (head decls2')--      -- logDataWithAnns "doRmDecl:(decls2')" (decls2')-      return $ (decls1 ++ decls2')---- ------------------------------------------------------------------------- | Remove multiple type signatures-rmTypeSigs :: (SYB.Data t) =>-         [GHC.Name]  -- ^ The identifiers whose type signatures are to be removed.-      -> t           -- ^ The declarations-      -> RefactGhc (t,[GHC.LSig GHC.RdrName])-                     -- ^ The result and removed signatures, if there-                     -- were any-rmTypeSigs pns t = do-  (t',demotedSigsMaybe) <- foldM (\(tee,ds) n -> do { (tee',d) <- rmTypeSig n tee; return (tee', ds++[d])}) (t,[]) pns-  return (t',catMaybes demotedSigsMaybe)---- ------------------------------------------------------------------------- | Remove the type signature that defines the given identifier's--- type from the declaration list.-rmTypeSig :: (SYB.Data t) =>-         GHC.Name    -- ^ The identifier whose type signature is to be removed.-      -> t           -- ^ The declarations-      -> RefactGhc (t,Maybe (GHC.LSig GHC.RdrName))-                     -- ^ The result and removed signature, if there-                     -- was one--                     -- NOTE: It may have originated from a SigD, it is up-                     -- to the calling function to insert this if required-rmTypeSig pn t-  = do-     setStateStorage StorageNone-     t' <- SYB.everywhereMStaged SYB.Renamer (SYB.mkM inMatch `SYB.extM` inPatDecl `SYB.extM` inModule) t-     storage <- getStateStorage-     let sig' = case storage of-                  StorageSigRdr sig -> Just sig-                  StorageNone       -> Nothing-                  x -> error $ "rmTypeSig: unexpected value in StateStorage:" ++ (show x)-     return (t',sig')-  where-   inModule :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource-   inModule (modu :: GHC.ParsedSource)-      = doRmTypeSig modu--   -- Deals with the distrinct parts of a FunBind-   inMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)-           -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))-   inMatch x@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))-      = doRmTypeSig x--   inPatDecl ::GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)-   inPatDecl x@(GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _))) = do-      decls <- liftT $ hsDeclsPatBindD x-      decls' <- doRmTypeSigDecls decls-      liftT $ replaceDeclsPatBindD x decls'--   inPatDecl x = return x--   -- ------------------------------------   doRmTypeSig :: (HasDecls t) => t -> RefactGhc t-   doRmTypeSig parent = do-     decls <- liftT $ hsDecls parent-     decls' <- doRmTypeSigDecls decls-     liftT $ replaceDecls parent decls'---   doRmTypeSigDecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]-   doRmTypeSigDecls decls = do-     isDone <- getDone-     if isDone-       then return decls-       else do-         -- logDataWithAnns "doRmTypeSig:decls" decls-         nameMap <- getRefactNameMap-         let (decls1,decls2)= break (definesSigDRdr nameMap pn) decls-         if not $ null decls2-            then do-              -- logDataWithAnns "doRmTypeSig:parent" parent-              let sig@(GHC.L sspan (GHC.SigD (GHC.TypeSig names typ p))) = ghead "rmTypeSig" decls2-              if length names > 1-                  then do-                      let newNames = filter (\rn -> rdrName2NamePure nameMap rn /= pn) names-                          newSig = GHC.L sspan (GHC.SigD (GHC.TypeSig newNames typ p))--                      liftT $ removeTrailingCommaT (glast "doRmTypeSig" newNames)--                      let pnt = ghead "rmTypeSig" (filter (\rn -> rdrName2NamePure nameMap rn == pn) names)-                      liftT $ removeTrailingCommaT pnt--                      -- Construct the old signature, by keeping the-                      -- signature part but discarding the other names-                      newSpan <- liftT uniqueSrcSpanT-                      let oldSig = (GHC.L newSpan (GHC.TypeSig [pnt] typ p))-                      liftT $ modifyAnnsT (copyAnn sig oldSig)-                      setStateStorage (StorageSigRdr oldSig)--                      return (decls1++[newSig]++gtail "doRmTypeSig" decls2)-                  else do-                      let [oldSig] = decl2Sig sig-                      setStateStorage (StorageSigRdr oldSig)-                      decls' <- doRmDecl decls1 decls2-                      return decls'-            else do-              return decls--   getDone = do-     s <- getStateStorage-     case s of-       StorageNone -> return False-       _           -> return True---- ------------------------------------------------------------------------- TODO: Is this function needed with GHC?---- | Remove the qualifier from the given identifiers in the given syntax phrase.-rmQualifier:: (SYB.Data t)-             =>[GHC.Name]       -- ^ The identifiers.-               ->t           -- ^ The syntax phrase.-               ->RefactGhc t -- ^ The result.-rmQualifier pns t = do-  nm <- getRefactNameMap-  SYB.everywhereM (nameSybTransform (rename nm)) t-    where-     rename nm (ln@(GHC.L l pn)::GHC.Located GHC.RdrName)-       | elem (rdrName2NamePure nm ln) pns-       = do-              case pn of-                GHC.Qual _ n -> return (GHC.L l (GHC.Unqual n))-                _            -> return ln-     rename _ x = return  x---- ------------------------------------------------------------------------- | Replace all occurences of a top level GHC.Name with a qualified version.-qualifyToplevelName :: GHC.Name -> RefactGhc ()-qualifyToplevelName n = do-    parsed <- getRefactParsed-    parsed' <- renamePN n n True parsed-    putRefactParsed parsed' emptyAnns-    return ()---- -----------------------------------------------------------------------data HowToQual = Qualify | NoQualify | PreserveQualify-               deriving (Show,Eq)---- | Rename each occurrences of the identifier in the given syntax--- phrase with the new name.---- TODO: the syntax phrase is required to be GHC.Located, not sure how--- to specify this without breaking the everywhereMStaged call--renamePN::(SYB.Data t)-   =>GHC.Name             -- ^ The identifier to be renamed.-   ->GHC.Name             -- ^ The new name, including possible qualifier-   ->Bool                 -- ^ True means use the qualified form for-                          --   the new name.-   ->t                    -- ^ The syntax phrase-   ->RefactGhc t-renamePN oldPN newName useQual t = do-  -- logm $ "renamePN: (oldPN,newName)=" ++ (showGhc (oldPN,newName))-  -- logm $ "renamePN: t=" ++ (SYB.showData SYB.Parser 0 t)-  nameMap <- getRefactNameMap-  newNameQual   <- rdrNameFromName True  newName-  newNameUnqual <- rdrNameFromName False newName-  newNameRdr    <- rdrNameFromName useQual newName-  -- logm $ "renamePN: (newNameQual,newNameUnqual,newNameRdr)=" ++ showGhc (newNameQual,newNameUnqual,newNameRdr)--  let-    cond :: GHC.Located GHC.RdrName -> Bool-    cond (GHC.L ln _) =-      case Map.lookup ln nameMap of-        Nothing -> False-        Just n -> GHC.nameUnique n == GHC.nameUnique oldPN--    -- Decision process for new names-    newNameCalcBool :: Bool -> GHC.RdrName -> GHC.RdrName-    newNameCalcBool True  n = newNameCalc Qualify   n-    newNameCalcBool False n = newNameCalc NoQualify n--    newNameCalc :: HowToQual -> GHC.RdrName -> GHC.RdrName-    newNameCalc uq old = newNameCalc' uq (GHC.isQual_maybe old)-      where-        newNameCalc' :: HowToQual -> (Maybe (GHC.ModuleName,GHC.OccName)) -> GHC.RdrName-        newNameCalc' Qualify         (Just (mn,_)) = GHC.Qual mn (GHC.occName newName)-        newNameCalc' PreserveQualify (Just (mn,_)) = GHC.Qual mn (GHC.occName newName)-        newNameCalc' NoQualify       (Just (_n,_)) = GHC.Unqual  (GHC.occName newName)-        newNameCalc' uq' _ =  if uq' == Qualify then newNameQual else newNameUnqual--    rename :: Bool -> GHC.Located GHC.RdrName -> Transform (GHC.Located GHC.RdrName)-    rename useQual' old@(GHC.L l n)-     | cond (GHC.L l n)-     = do-          logTr $ "renamePN:rename at :" ++ showGhc l-          let nn = newNameCalcBool useQual' n-          -- A RdrName Can have a number of constructors, which are used to-          -- index the annotations associated with it. Make sure the annotation-          -- lines up.-          let new = (GHC.L l nn)-          modifyAnnsT (replaceAnnKey old new)--          return new-    rename _ x = return x--    renameVar :: Bool -> (GHC.Located (GHC.HsExpr GHC.RdrName)) -> Transform (GHC.Located (GHC.HsExpr GHC.RdrName))-    renameVar useQual' (GHC.L l (GHC.HsVar n))-     | cond (GHC.L l n)-     = do-          logTr $ "renamePN:renameVar at :" ++ (showGhc l)-          -- logTr $ "renamePN:renameVar useQual' :" ++ (show useQual')-          -- logTr $ "renamePN:renameVar ln :" ++ SYB.showData SYB.Parser 0 (GHC.L l (GHC.HsVar n))-          let-            nn = if useQual'-                   then newNameCalcBool useQual'        n-                   else newNameCalc     PreserveQualify n-          return (GHC.L l (GHC.HsVar nn))-    renameVar _ x = return x--    -- HsTyVar {Name: Renaming.D1.Tree}))-    renameTyVar :: Bool -> (GHC.Located (GHC.HsType GHC.RdrName)) -> Transform (GHC.Located (GHC.HsType GHC.RdrName))-    renameTyVar useQual' (GHC.L l (GHC.HsTyVar n))-     | cond (GHC.L l n)-     = do-          logTr $ "renamePN:renameTyVar at :" ++ (showGhc l)-          let nn = newNameCalcBool useQual' n-          return (GHC.L l (GHC.HsTyVar nn))-    renameTyVar _ x = return x---    renameHsTyVarBndr :: Bool -> GHC.LHsTyVarBndr GHC.RdrName -> Transform (GHC.LHsTyVarBndr GHC.RdrName)-    renameHsTyVarBndr useQual' (GHC.L l (GHC.UserTyVar n))-     | cond (GHC.L l n)-     = do-          logTr $ "renamePN:renameHsTyVarBndr at :" ++ (showGhc l)-          let nn = newNameCalcBool useQual' n-          return (GHC.L l (GHC.UserTyVar nn))-    renameHsTyVarBndr _ x = return x--    -- -----------------------------------    renameLIE :: Bool -> (GHC.LIE GHC.RdrName) -> Transform (GHC.LIE GHC.RdrName)-    renameLIE useQual' (GHC.L l (GHC.IEVar old@(GHC.L ln n)))-     | cond (GHC.L ln n)-     = do-          -- logTr $ "renamePN:renameLIE.IEVar at :" ++ (showGhc l)-          let new = newNameCalcBool useQual' n--          let newn = (GHC.L ln new)-          modifyAnnsT (replaceAnnKey old newn)--          return (GHC.L l (GHC.IEVar (GHC.L ln new)))--    renameLIE useQual' (GHC.L l (GHC.IEThingAbs old@(GHC.L ln n)))-     | cond (GHC.L l n)-     = do-          -- logTr $ "renamePN:renameLIE.IEThingAbs at :" ++ (showGhc l)-          let new = newNameCalcBool useQual' n--          let newn = (GHC.L ln new)-          modifyAnnsT (replaceAnnKey old newn)--          return (GHC.L l (GHC.IEThingAbs (GHC.L ln new)))--    renameLIE useQual' (GHC.L l (GHC.IEThingAll old@(GHC.L ln n)))-     | cond (GHC.L ln n)-     = do-          -- logTr $ "renamePN:renameLIE.IEThingAll at :" ++ (showGhc l)-          let new = newNameCalcBool useQual' n--          let newn = (GHC.L ln new)-          modifyAnnsT (replaceAnnKey old newn)--          return (GHC.L l (GHC.IEThingAll (GHC.L ln new)))--    -- TODO: check inside the ns here too-    renameLIE useQual' (GHC.L l (GHC.IEThingWith old@(GHC.L ln n) ns))-     = do--         old' <- if (cond (GHC.L ln n))-           then do-             logTr $ "renamePN:renameLIE.IEThingWith at :" ++ (showGhc l)-             let new = newNameCalcBool useQual' n--             let newn = (GHC.L ln new)-             modifyAnnsT (replaceAnnKey old newn)--             return (GHC.L ln new)-           else return old---         ns' <- if (any (\(GHC.L lnn nn) -> cond (GHC.L lnn nn)) ns)-           then renameTransform useQual' ns-           else return ns-         return (GHC.L l (GHC.IEThingWith old' ns'))--    renameLIE _ x = do-         -- logTr $ "renamePN:renameLIE miss for :" ++ (showGhc x)-         return x--    -- -----------------------------------    renameLPat :: Bool -> (GHC.LPat GHC.RdrName) -> Transform (GHC.LPat GHC.RdrName)-    renameLPat useQual' (GHC.L l (GHC.VarPat n))-     | cond (GHC.L l n)-     = do-          logTr $ "renamePNworker:renameLPat at :" ++ (showGhc l)-          let nn = newNameCalcBool useQual' n-          return (GHC.L l (GHC.VarPat nn))-    renameLPat _ x = return x--    renameFunBind :: Bool -> GHC.HsBindLR GHC.RdrName GHC.RdrName -> Transform (GHC.HsBindLR GHC.RdrName GHC.RdrName)-    renameFunBind _useQual (GHC.FunBind (GHC.L ln n) fi (GHC.MG matches a typ o) co fvs tick)-     | cond (GHC.L ln n)-     = do -- Need to (a) rename the actual funbind name-          --         NOTE: due to bottom-up traversal, (a) should-          --               already have been done.-          --         (b) rename each of 'tail matches'-          --             (head is renamed in (a) )-          -- logTr $ "renamePN.renameFunBind"-          -- Now do (b)-          logTr $ "renamePN.renameFunBind.renameFunBind:starting matches"-          let w lmatch@(GHC.L lm (GHC.Match mln pats typ' grhss)) = do-                case mln of-                  Just (old@(GHC.L lmn _),f) -> do-                    -- A RdrName Can have a number of constructors, which are used to-                    -- index the annotations associated with it. Make sure the annotation-                    -- lines up.-                    let new = (GHC.L lmn newNameUnqual)-                    modifyAnnsT (replaceAnnKey old new)--                    return (GHC.L lm (GHC.Match (Just (new,f)) pats typ' grhss))-                  Nothing -> return lmatch-          matches' <- mapM w matches-          logTr $ "renamePN.renameFunBind.renameFunBind.renameFunBind:matches done"-          return (GHC.FunBind (GHC.L ln newNameRdr) fi (GHC.MG matches' a typ o) co fvs tick)-    renameFunBind _ x = return x--    renameImportDecl :: Bool -> (GHC.ImportDecl GHC.RdrName) -> Transform (GHC.ImportDecl GHC.RdrName)-    renameImportDecl _useQual (GHC.ImportDecl src mn mq isrc isafe iq ii ma (Just (ij,GHC.L ll ies))) = do-      ies' <- mapM (renameLIE False) ies-      logTr $ "renamePN'.renameImportDecl:(ies,ies')=" ++ showGhc (ies,ies')-      return (GHC.ImportDecl src mn mq isrc isafe iq ii ma (Just (ij,GHC.L ll ies')))-    renameImportDecl _ x = return x--    renameTypeSig :: Bool -> (GHC.Sig GHC.RdrName) -> Transform (GHC.Sig GHC.RdrName)-    renameTypeSig _useQual (GHC.TypeSig ns typ p)-     = do-         logTr $ "renamePN:renameTypeSig"-         -- Has already been renamed, make sure qualifier is removed-         ns'  <- renameTransform False ns-         typ' <- renameTransform False typ-         logTr $ "renamePN:renameTypeSig done"-         return (GHC.TypeSig ns' typ' p)-    renameTypeSig _ x = return x--    renameTransform useQual' t' =-          -- Note: bottom-up traversal (no ' at end)-            (SYB.everywhereM (-            -- (everywhereM' (-                   SYB.mkM   (rename            useQual')-                  `SYB.extM` (renameVar         useQual')-                  `SYB.extM` (renameTyVar       useQual')-                  `SYB.extM` (renameHsTyVarBndr useQual')-                  `SYB.extM` (renameLIE         useQual')-                  `SYB.extM` (renameLPat        useQual')-                  `SYB.extM` (renameTypeSig     useQual')-                  `SYB.extM` (renameImportDecl  useQual')-                  `SYB.extM` (renameFunBind     useQual')-                   ) t')-  t' <- liftT (renameTransform useQual t)-  return t'---- ------------------------------------------------------------------------- | Check whether the specified identifier is declared in the given syntax phrase t,--- if so, rename the identifier by creating a new name automatically.-autoRenameLocalVar:: (SYB.Data t)-                     => GHC.Name    -- ^ The identifier.-                     -> t           -- ^ The syntax phrase.-                     -> RefactGhc t -- ^ The result.-autoRenameLocalVar pn t = do-  logm $ "autoRenameLocalVar: (pn)=" ++ (showGhc (pn))-  -- = everywhereMStaged SYB.Renamer (SYB.mkM renameInMatch)-  nm <- getRefactNameMap-  decls <- liftT $ hsDeclsGeneric t-  if isDeclaredInRdr nm pn decls-         then do t' <- worker t-                 return t'-         else do return t--      where-         worker :: (SYB.Data t) => t -> RefactGhc t-         worker tt-                   =do (f,d) <- hsFDNamesFromInsideRdr tt-                       ds <- hsVisibleNamesRdr pn tt-                       let newNameStr = mkNewName (nameToString pn) (nub (f `union` d `union` ds)) 1-                       newName <- mkNewGhcName Nothing newNameStr-                       renamePN pn newName False tt---- -----------------------------------------------------------------------isMainModule :: GHC.Module -> Bool-isMainModule modu = GHC.modulePackageKey modu == GHC.mainPackageKey---- ------------------------------------------------------------------------- | Return the identifier's defining location.--- defineLoc::PNT->SrcLoc-defineLoc :: GHC.Located GHC.Name -> GHC.SrcLoc-defineLoc (GHC.L _ name) = GHC.nameSrcLoc name---- | Return the identifier's source location.--- useLoc::PNT->SrcLoc-useLoc:: (GHC.Located GHC.Name) -> GHC.SrcLoc--- useLoc (GHC.L l _) = getGhcLoc l-useLoc (GHC.L l _) = GHC.srcSpanStart l---- ------------------------------------------------------------------------- | Return True if the identifier is used in the RHS if a--- function\/pattern binding.-isUsedInRhs::(SYB.Data t) => (GHC.Located GHC.Name) -> t -> Bool-isUsedInRhs pnt t = useLoc pnt /= defineLoc pnt  && not (notInLhs)-  where-    notInLhs = fromMaybe False $ SYB.somethingStaged SYB.Parser Nothing-            (Nothing `SYB.mkQ` inMatch `SYB.extQ` inDecl) t-     where-      inMatch ((GHC.FunBind name _ (GHC.MG _matches _ _ _) _ _ _) :: GHC.HsBind GHC.Name)-         | isJust (find (sameOccurrence pnt) [name]) = Just True-      inMatch _ = Nothing--      inDecl ((GHC.TypeSig is _ _) :: GHC.Sig GHC.Name)-        |isJust (find (sameOccurrence pnt) is)   = Just True-      inDecl _ = Nothing---- ------------------------------------------------------------------------ | Find all occurrences with location of the given name-findAllNameOccurences :: (SYB.Data t) => GHC.Name -> t -> [(GHC.Located GHC.Name)]-findAllNameOccurences  name t-  = res-       where-        res = SYB.everythingStaged SYB.Renamer (++) []-            ([] `SYB.mkQ` worker `SYB.extQ` workerBind `SYB.extQ` workerExpr) t--        worker (ln@(GHC.L _l n) :: (GHC.Located GHC.Name))-          | GHC.nameUnique n == GHC.nameUnique name = [ln]-        worker _ = []--        workerBind (GHC.L l (GHC.VarPat n) :: (GHC.Located (GHC.Pat GHC.Name)))-          | GHC.nameUnique n == GHC.nameUnique name  = [(GHC.L l n)]-        workerBind _ = []--        workerExpr (GHC.L l (GHC.HsVar n) :: (GHC.Located (GHC.HsExpr GHC.Name)))-          | GHC.nameUnique n == GHC.nameUnique name  = [(GHC.L l n)]-        workerExpr _ = []---- -----------------------------------------------------------------------findNameInRdr :: (SYB.Data t) => NameMap -> GHC.Name -> t -> Bool-findNameInRdr nm pn t =- isJust $ SYB.something (Nothing `SYB.mkQ` worker) t-   where-      worker (ln :: GHC.Located GHC.RdrName)-         | GHC.nameUnique pn == GHC.nameUnique (rdrName2NamePure nm ln) = Just True-      worker _ = Nothing---- ------------------------------------------------------------------------- | Return True if the identifier occurs in the given syntax phrase.-findPNT::(SYB.Data t) => GHC.Located GHC.Name -> t -> Bool-findPNT (GHC.L _ pn) = findPN pn---- | Return True if the identifier occurs in the given syntax phrase.-findPN::(SYB.Data t)=> GHC.Name -> t -> Bool-findPN pn-   = isJust . SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` worker)-     where-        worker (n::GHC.Name)-           | GHC.nameUnique pn == GHC.nameUnique n = Just True-        worker _ = Nothing---- | Return True if any of the specified PNames ocuur in the given syntax phrase.-findPNs::(SYB.Data t)=> [GHC.Name] -> t -> Bool-findPNs pns-   = isJust . SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` worker)-     where-        uns = map GHC.nameUnique pns--        worker (n::GHC.Name)-           | elem (GHC.nameUnique n) uns = Just True-        worker _ = Nothing---- ------------------------------------------------------------------------- | Return True if any of the specified PNames ocuur in the given syntax phrase.-findNamesRdr :: (SYB.Data t) => NameMap -> [GHC.Name] -> t -> Bool-findNamesRdr nm pns t =-  isJust $ SYB.something (inName) t-    where-      -- r = (SYB.everythingStaged SYB.Parser mappend mempty (inName) t)--      checker :: GHC.Located GHC.RdrName -> Maybe Bool-      checker ln-         | elem (GHC.nameUnique (rdrName2NamePure nm ln)) uns = Just True-      checker _ = Nothing--      inName :: (SYB.Typeable a) => a -> Maybe Bool-      inName = nameSybQuery checker--      uns = map GHC.nameUnique pns---- ------------------------------------------------------------------------- | Return the type checked `GHC.Id` corresponding to the given--- `GHC.Name`---- TODO: there has to be a simpler way, using the appropriate GHC internals-findIdForName :: GHC.Name -> RefactGhc (Maybe GHC.Id)-findIdForName n = do-  tm <- getTypecheckedModule-  let t = GHC.tm_typechecked_source tm-  let r = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` worker) t-      worker (i::GHC.Id)-         | (GHC.nameUnique n) ==  (GHC.varUnique i) = Just i-      worker _ = Nothing-  return r---- -----------------------------------------------------------------------getTypeForName :: GHC.Name -> RefactGhc (Maybe GHC.Type)-getTypeForName n = do-  mId <-  findIdForName n-  case mId of-    Nothing -> return Nothing-    Just i -> return $ Just (GHC.varType i)---- ------------------------------------------------------------------------- | Given the syntax phrase, find the largest-leftmost expression--- contained in the region specified by the start and end position, if--- found.-locToExp:: (SYB.Data t,SYB.Typeable n) =>-                   SimpPos    -- ^ The start position.-                -> SimpPos    -- ^ The end position.-                -> t          -- ^ The syntax phrase.-                -> Maybe (GHC.Located (GHC.HsExpr n)) -- ^ The result.-locToExp beginPos endPos t = res-  where-     res = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` expr) t--     expr :: GHC.Located (GHC.HsExpr n) -> (Maybe (GHC.Located (GHC.HsExpr n)))-     expr e-        |inScope e = Just e-     expr _ = Nothing--     inScope :: GHC.Located e -> Bool-     inScope (GHC.L l _) =-       let-         (startLoc,endLoc) = case l of-           (GHC.RealSrcSpan ss) ->-             ((GHC.srcSpanStartLine ss,GHC.srcSpanStartCol ss),-              (GHC.srcSpanEndLine ss,GHC.srcSpanEndCol ss))-           (GHC.UnhelpfulSpan _) -> ((0,0),(0,0))-       in-        (startLoc>=beginPos) && (startLoc<= endPos) && (endLoc>= beginPos) && (endLoc<=endPos)-------------------------------------------------------------------------------------ghcToPN :: GHC.RdrName -> PName-ghcToPN rdr = PN rdr--lghcToPN :: GHC.Located GHC.RdrName -> PName-lghcToPN (GHC.L _ rdr) = PN rdr----- | If an expression consists of only one identifier then return this--- identifier in the GHC.Name format, otherwise return the default Name-expToName:: GHC.LHsExpr GHC.Name -> GHC.Name -- TODO: Use a Maybe, rather than defaultName-expToName (GHC.L _ (GHC.HsVar pnt)) = pnt-expToName (GHC.L _ (GHC.HsPar e))   = expToName e-expToName _ = defaultName---- | If an expression consists of only one identifier then return this--- identifier in the GHC.Name format, otherwise return the default Name-expToNameRdr :: NameMap -> GHC.LHsExpr GHC.RdrName -> Maybe GHC.Name-expToNameRdr nm (GHC.L l (GHC.HsVar pnt)) = Just (rdrName2NamePure nm (GHC.L l pnt))-expToNameRdr nm (GHC.L _ (GHC.HsPar e))   = expToNameRdr nm e-expToNameRdr _ _ = Nothing--nameToString :: GHC.Name -> String--- nameToString name = showGhc name-nameToString name = showGhcQual name---- | If a pattern consists of only one identifier then return this--- identifier, otherwise return Nothing-patToNameRdr :: NameMap -> GHC.LPat GHC.RdrName -> Maybe GHC.Name-patToNameRdr nm (GHC.L l (GHC.VarPat n)) = Just (rdrName2NamePure nm (GHC.L l n))-patToNameRdr _ _ = Nothing---- | If a pattern consists of only one identifier then return this--- identifier, otherwise return Nothing-patToPNT :: GHC.LPat GHC.Name -> Maybe GHC.Name-patToPNT (GHC.L _ (GHC.VarPat n)) = Just n-patToPNT _ = Nothing---- | Compose a pattern from a pName.-pNtoPat :: name -> GHC.Pat name-pNtoPat pname = GHC.VarPat pname+   , hsQualifier++    -- ** Property checking+    ,isVarId,isConId,isOperator,isTopLevelPN,isLocalPN,isNonLibraryName+    ,isQualifiedPN, isFunOrPatName, isTypeSig, isTypeSigDecl+    ,isFunBindP,isFunBindR,isPatBindP,isPatBindR,isSimplePatBind,isSimplePatDecl+    ,isComplexPatBind,isComplexPatDecl,isFunOrPatBindP,isFunOrPatBindR++    -- ** Getting+    , findEntity'+    , findIdForName+    , getTypeForName++    ,definesTypeSigRdr+    ,sameBindRdr+    ,UsedByRhs(..)++    -- ** Modules and files+    -- ,clientModsAndFiles,serverModsAndFiles,isAnExistingMod+    -- ,fileNameToModName, strToModName, modNameToStr+    , isMainModule+    , getModule++    -- ** Locations+    ,defineLoc, useLoc, locToExp+    -- ,locToName+    , locToRdrName+    ,getName++ -- * Program transformation+    -- ** Adding+    ,addDecl, addItemsToImport, addItemsToExport, addHiding+    ,addParamsToDecls, addParamsToSigs, addActualParamsToRhs, addImportDecl, duplicateDecl++    -- ** Removing+    ,rmDecl, rmTypeSig, rmTypeSigs -- , commentOutTypeSig, rmParams+    -- ,rmItemsFromExport, rmSubEntsFromExport, Delete(delete)++    -- ** Updating+    , rmQualifier, qualifyToplevelName, renamePN, HowToQual(..), autoRenameLocalVar++    -- ** Identifiers, expressions, patterns and declarations+    , expToNameRdr+    ,nameToString+    ,patToNameRdr+    , pNtoPat+    , usedWithoutQualR++    -- ** Others+    , divideDecls+    , mkRdrName,mkQualifiedRdrName,mkNewGhcName,mkNewName,mkNewToplevelName+    , registerRdrName++    -- The following functions are not in the the API yet.+    , causeNameClashInExports {- , inRegion , unmodified -}++    , declsSybTransform++    -- * Typed AST traversals (added by CMB)+    -- * Miscellous+    -- ,removeFromInts, getDataName, checkTypes, getPNs, getPN, getPNPats, mapASTOverTAST++    -- * Debug stuff+    , rdrNameFromName+ ) where++import Control.Monad.State+import Data.Char+import Data.Foldable+import Data.List+import Data.Maybe+import Exception++import Language.Haskell.Refact.Utils.ExactPrint+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.Types+import Language.Haskell.Refact.Utils.Variables++import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Types+import Language.Haskell.GHC.ExactPrint.Utils+++-- Modules from GHC+import qualified FastString    as GHC+import qualified GHC           as GHC+import qualified Module        as GHC+import qualified Name          as GHC+import qualified Outputable    as GHC+import qualified RdrName       as GHC+import qualified TyCon         as GHC+#if __GLASGOW_HASKELL__ <= 710+import qualified TypeRep       as GHC+#else+import qualified TyCoRep       as GHC+import qualified BasicTypes    as GHC+#endif+import qualified Unique        as GHC+import qualified Var           as GHC++import qualified Var           as Var++import qualified Data.Generics as SYB+import qualified GHC.SYB.Utils as SYB++import qualified Data.Map as Map++import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero)++-- ---------------------------------------------------------------------+-- |Process the inscope relation returned from the parsing and module+-- analysis pass, and return a list of four-element tuples. Each tuple+-- contains an identifier name, the identifier's namespace info, the+-- identifier's defining module name and its qualifier name.+--+-- The same identifier may have multiple entries in the result because+-- it may have different qualifiers. This makes it easier to decide+-- whether the identifier can be used unqualifiedly by just checking+-- whether there is an entry for it with the qualifier field being+-- Nothing.+--+inScopeInfo :: InScopes                                      -- ^ The inscope relation .+           ->[(String, GHC.NameSpace, GHC.ModuleName, Maybe GHC.ModuleName)] -- ^ The result+inScopeInfo names = nub $  map getEntInfo $ names+  where+     getEntInfo name+       =(showGhc name,+         GHC.occNameSpace $ GHC.nameOccName name,+         GHC.moduleName $ GHC.nameModule name,+         getQualMaybe $ GHC.nameRdrName name)++     getQualMaybe rdrName = case rdrName of+       GHC.Qual modName _occName -> Just modName+       _                         -> Nothing+++-- ---------------------------------------------------------------------++-- | Return True if the identifier is inscope and can be used without+-- a qualifier.+isInScopeAndUnqualified::String       -- ^ The identifier name.+                       ->InScopes     -- ^ The inscope relation+                       ->Bool         -- ^ The result.+isInScopeAndUnqualified n names+ = isJust $ find (\ (x, _,_, qual) -> x == n && isNothing qual ) $ inScopeInfo names++-- | Return True if the identifier is inscope and can be used without+-- a qualifier. The identifier name string may have a qualifier+-- already+-- NOTE: may require qualification based on name clash with an+-- existing identifier.+isInScopeAndUnqualifiedGhc ::+     String           -- ^ The identifier name.+  -> (Maybe GHC.Name) -- ^ Existing name, to be excluded from test, if+                      --   known+  -> RefactGhc Bool   -- ^ The result.+isInScopeAndUnqualifiedGhc n maybeExising = do+  names <- ghandle handler (GHC.parseName n)+  logm $ "isInScopeAndUnqualifiedGhc:(n,(maybeExising,names))=" ++ (show n) ++ ":" ++  (showGhc (maybeExising,names))+  ctx <- GHC.getContext+  logm $ "isInScopeAndUnqualifiedGhc:ctx=" ++ (showGhc ctx)+  let nameList = case maybeExising of+                  Nothing -> names+                  Just n' -> filter (\x -> (showGhcQual x) /= (showGhcQual n')) names+  logm $ "isInScopeAndUnqualifiedGhc:(n,nameList)=" ++ (show n) ++ ":" ++  (showGhc nameList)+  return $ nameList /= []++  where+    handler:: SomeException -> RefactGhc [GHC.Name]+    handler e = do+      logm $ "isInScopeAndUnqualifiedGhc.handler e=" ++ (show e)+      return []++-- ---------------------------------------------------------------------++-- |Return all 'GHC.Name's that correspond to the given string, in the current+-- module.++-- Note: this returns a list because TH constructor names do not have the+-- correct namespace so the two variants are returned, constructor and+-- non-constructor. I suspect that when this is looked up only one will ever+-- come through. Hence we should only ever see 0 or 1 names here.+inScopeNames :: String               -- ^ The identifier name.+             -> RefactGhc [GHC.Name] -- ^ The result.+inScopeNames n = do+  names <- ghandle handler (GHC.parseName n)+  logm $ "inScopeNames:(n,names)=" ++ (show n) ++ ":" ++  (showGhc names)+  return $ names++  where+    handler:: SomeException -> RefactGhc [GHC.Name]+    handler e = do+      logm $ "inScopeNames.handler e=" ++ (show e)+      return []++-- ---------------------------------------------------------------------++-- |Given a 'GHC.Name' defined in one module, find the equivalent one in the+-- currently loaded module. This is required otherwise name equality checking+-- based on 'GHC.nameUnique' will fail.+equivalentNameInNewMod :: GHC.Name -> RefactGhc [GHC.Name]+equivalentNameInNewMod old = do+  -- we have to do it this way otherwise names imported qualified will not be+  -- detected++  -- ghc-mod 5.6 introduced a funny whereby the packagekey for the inscopes is+  -- "main@main" but for the current file is "main@main"+  -- So ignore the packagekey for now+  -- See https://github.com/DanielG/ghc-mod/issues/811+  -- TODO: revisit this+  -- let eqModules (GHC.Module pk1 mn1) (GHC.Module pk2 mn2) = mn1 == mn2+  let eqModules (GHC.Module pk1 mn1) (GHC.Module pk2 mn2) = mn1 == mn2 && pk1 == pk2++  gnames <- GHC.getNamesInScope+  logm $ "equivalentNameInNewMod:gnames=" ++ showGhcQual (map (\n -> (GHC.nameModule n,n)) gnames)+  let clientModule = GHC.nameModule old+  logm $ "equivalentNameInNewMod:(old,clientModule)=" ++ showGhcQual (old,clientModule)+  let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames+  let clientInscopes = filter (\n -> eqModules clientModule (GHC.nameModule n)) gnames+  logm $ "equivalentNameInNewMod:clientInscopes=" ++ showGhcQual clientInscopes+  let newNames = filter (\n -> showGhcQual n == showGhcQual old) clientInscopes+  return newNames++-- ---------------------------------------------------------------------++-- | Return all the possible qualifiers for the identifier. The identifier+-- is not inscope if the result is an empty list. NOTE: This is intended to be+-- used when processing a client module, so the 'GHC.Name' parameter is actually+-- from a different module.+hsQualifier :: GHC.Name                   -- ^ The identifier.+            -> RefactGhc [GHC.ModuleName] -- ^ The result.+hsQualifier pname = do+  names <- inScopeNames (showGhc pname)+  let mods = map (GHC.moduleName . GHC.nameModule) names+  return mods++-- ---------------------------------------------------------------------++-- |Make a qualified 'GHC.RdrName'+mkQualifiedRdrName :: GHC.ModuleName -> String -> GHC.RdrName+mkQualifiedRdrName mn s = GHC.mkRdrQual mn (GHC.mkVarOcc s)++-- |Make a simple unqualified 'GHC.RdrName'+mkRdrName :: String -> GHC.RdrName+mkRdrName s = GHC.mkVarUnqual (GHC.mkFastString s)++-- ---------------------------------------------------------------------++-- |Register a 'GHC.Located' 'GHC.RdrName' in the 'NameMap' so it can be looked+-- up if needed. This will create a brand new 'GHC.Name', so no guarantees are+-- given as to matches later. Perhaps this is a bad idea.+registerRdrName :: GHC.Located GHC.RdrName -> RefactGhc ()+registerRdrName (GHC.L l rn) = do+  case GHC.isQual_maybe rn of+    Nothing -> do+      n <- mkNewGhcName Nothing (showGhc rn)+      addToNameMap l n+    Just (mn,oc) -> do+#if __GLASGOW_HASKELL__ <= 710+      n <- mkNewGhcName (Just (GHC.Module (GHC.stringToPackageKey "HaRe") mn)) (showGhc oc)+#else+      n <- mkNewGhcName (Just (GHC.Module (GHC.stringToUnitId "HaRe") mn)) (showGhc oc)+#endif+      addToNameMap l n++-- ---------------------------------------------------------------------++-- | Make a new GHC.Name, using the Unique Int sequence stored in the+-- RefactState.+mkNewGhcName :: Maybe GHC.Module -> String -> RefactGhc GHC.Name+mkNewGhcName maybeMod name = do+  s <- get+  u <- gets rsUniqState+  put s { rsUniqState = (u+1) }+  return (mkNewGhcNamePure 'H' (u + 1) maybeMod name)+++-- ---------------------------------------------------------------------++mkNewToplevelName :: GHC.Module -> String -> GHC.SrcSpan -> RefactGhc GHC.Name+mkNewToplevelName modid name defLoc = do+  s <- get+  u <- gets rsUniqState+  put s { rsUniqState = (u+1) }++  let un = GHC.mkUnique 'H' (u+1) -- H for HaRe :)+      n = GHC.mkExternalName un modid (GHC.mkVarOcc name) defLoc+  return n++---------------------------------------------------------------------------+++-- |Create a new name base on the old name. Suppose the old name is 'f', then+--  the new name would be like 'f_i' where 'i' is an integer.+mkNewName::String      -- ^ The old name+          ->[String]   -- ^ The set of names which the new name cannot take+          ->Int        -- ^ The posfix value+          ->String     -- ^ The result+mkNewName oldName fds suffix+  =let newName=if suffix==0 then oldName+                            else oldName++"_"++ show suffix+   in if elem newName fds+        then mkNewName oldName fds (suffix+1)+        else newName++-- ---------------------------------------------------------------------++-- | Return True if the current module is exported either by default+-- or by specifying the module name in the export.+modIsExported:: GHC.ModuleName       -- ^ The module name+               -> GHC.RenamedSource  -- ^ The AST of the module+               -> Bool               -- ^ The result+modIsExported modName (_g,_emps,mexps,_mdocs)+   = let+       modExported (GHC.L _ (GHC.IEModuleContents (GHC.L _ name))) = name == modName+       modExported _ = False++       moduleExports = filter modExported $ fromMaybe [] mexps++     in if isNothing mexps+           then True+           else (nonEmptyList moduleExports)++-- ---------------------------------------------------------------------++-- | Return True if an identifier is exported by the module currently+-- being refactored.+isExported :: GHC.Name -> RefactGhc Bool+isExported n = do+  typechecked <- getTypecheckedModule+  let modInfo = GHC.tm_checked_module_info typechecked+  return $ GHC.modInfoIsExportedName modInfo n++-- ---------------------------------------------------------------------++-- | Return True if an identifier is explicitly exported by the module.+isExplicitlyExported:: NameMap+                    -> GHC.Name           -- ^ The identifier+                    -> GHC.ParsedSource -- ^ The AST of the module+                    -> Bool              -- ^ The result+isExplicitlyExported nm pn (GHC.L _ p)+  = findNameInRdr nm pn  (GHC.hsmodExports p)++-- ---------------------------------------------------------------------++-- | Check if the proposed new name will conflict with an existing export+causeNameClashInExports::  NameMap+                        -> GHC.Name          -- ^ The original name+                        -> GHC.Name          -- ^ The new name+                        -> GHC.ModuleName    -- ^ The identity of the module+                        -> GHC.ParsedSource -- ^ The AST of the module+                        -> Bool              -- ^ The result++-- Note that in the abstract representation of exps, there is no qualified entities.+causeNameClashInExports nm pn newName modName parsed@(GHC.L _ p)+  = let exps = GHC.unLoc $ fromMaybe (GHC.noLoc []) (GHC.hsmodExports p)+        varExps = concatMap nameFromExport $ filter isImpVar exps+        nameFromExport (GHC.L _ (GHC.IEVar x)) = [rdrName2NamePure nm x]+        nameFromExport _                       = []+        -- TODO: make withoutQual part of the API+        withoutQual n = showGhc $ GHC.localiseName n+        modNames=nub (concatMap (\x -> if withoutQual x== withoutQual newName+                                         then [GHC.moduleName $ GHC.nameModule x]+                                         else []) varExps)+        res = (isExplicitlyExported nm pn parsed) &&+               ( any modIsUnQualifedImported modNames+                 || elem modName modNames)+    in res+ where+    isImpVar (GHC.L _ x) = case x of+      GHC.IEVar _ -> True+      _           -> False++    modIsUnQualifedImported modName'+     =let+      in isJust $ find (\(GHC.L _ (GHC.ImportDecl _ (GHC.L _ modName1) _qualify _source _safe isQualified _isImplicit _as _h))+                                -> modName1 == modName' && (not isQualified)) (GHC.hsmodImports p)++-- Original seems to be+--   1. pick up any module names in the export list with same unQual+     --   part as the new name+--   2. Check if the old is exported explicitly+--   3.  if so, if the new module is exported unqualified+--        or belongs to the current module+--       then it will cause a clash++------------------------------------------------------------------------++-- | Return True if the identifier is unqualifiedly used in the given syntax+-- phrase. Check in a way that the test can be done in a client module, i.e. not+-- using the nameUnique+-- usedWithoutQualR :: GHC.Name -> GHC.ParsedSource -> Bool+usedWithoutQualR :: (SYB.Data t) => GHC.Name -> t -> Bool+usedWithoutQualR name t = isJust $ SYB.something (inName) t+  where+     inName :: (SYB.Typeable a) => a -> Maybe Bool+     inName = nameSybQuery checkName++     -- ----------------++     checkName ((GHC.L _ pn)::GHC.Located GHC.RdrName)+        -- Check the OccName match, for use in a client module refactoring+        | ((GHC.rdrNameOcc pn) == (GHC.nameOccName name)) &&+          GHC.isUnqual pn     = Just True+     checkName _ = Nothing++-----------------------------------------------------------------------------++getModule :: RefactGhc GHC.Module+getModule = do+  typechecked <- getTypecheckedModule+  return $ GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module typechecked++-- ---------------------------------------------------------------------++-- | Return True if a string is a lexically  valid variable name.+isVarId :: String -> Bool+isVarId mid = isId mid && isSmall (ghead "isVarId" mid)+     where isSmall c=isLower c || c=='_'++-- | Return True if a string is a lexically valid constructor name.+isConId :: String -> Bool+isConId mid = isId mid && isUpper (ghead "isConId" mid)++-- | Return True if a string is a lexically valid operator name.+isOperator :: String -> Bool+isOperator mid = mid /= [] && isOpSym (ghead "isOperator" mid) &&+                isLegalOpTail (tail mid) && not (isReservedOp mid)+   where+    isOpSym mid' = elem mid' opSymbols+       where opSymbols = ['!', '#', '$', '%', '&', '*', '+','.','/','<','=','>','?','@','\'','^','|','-','~']++    isLegalOpTail tail' = all isLegal tail'+       where isLegal c = isOpSym c || c==':'++    isReservedOp mid' = elem mid' reservedOps+       where reservedOps = ["..", ":","::","=","\"", "|","<-","@","~","=>"]++-- | Returns True if a string lexically is an identifier.+-- *This function should not be exported.*+isId::String->Bool+isId mid = mid/=[] && isLegalIdTail (tail mid) && not (isReservedId mid)+  where+    isLegalIdTail tail' = all isLegal tail'+        where isLegal c=isSmall c|| isUpper c || isDigit c || c=='\''++    isReservedId mid' = elem mid' reservedIds+      where reservedIds=["case", "class", "data", "default", "deriving","do","else" ,"if",+                         "import", "in", "infix","infixl","infixr","instance","let","module",+                         "newtype", "of","then","type","where","_"]++    isSmall c=isLower c || c=='_'++-----------------------------------------------------------------------------++-- |Return True if a PName is a toplevel PName.+isTopLevelPN::GHC.Name -> RefactGhc Bool+isTopLevelPN n = do+  typechecked <- getTypecheckedModule+  let maybeNames = GHC.modInfoTopLevelScope $ GHC.tm_checked_module_info typechecked+  let names = fromMaybe [] maybeNames+  return $ n `elem` names+++-- |Return True if a PName is a local PName.+isLocalPN::GHC.Name -> Bool+isLocalPN = GHC.isInternalName++-- |Return True if the name has a @GHC.SrcSpan@, i.e. is declared in+-- source we care about+isNonLibraryName :: GHC.Name -> Bool+isNonLibraryName n = case (GHC.nameSrcSpan n) of+  GHC.UnhelpfulSpan _ -> False+  _                   -> True++-- |Return True if a PName is a function\/pattern name defined in t.+isFunOrPatName :: (SYB.Data t) => NameMap -> GHC.Name -> t -> Bool+isFunOrPatName nm pn+   = isJust . SYB.something (Nothing `SYB.mkQ` worker `SYB.extQ` workerDecl)+     where+        worker (decl::GHC.LHsBind GHC.RdrName)+           | definesRdr nm pn decl = Just True+        worker _ = Nothing++        workerDecl (GHC.L l (GHC.ValD decl)::GHC.LHsDecl GHC.RdrName)+           | definesRdr nm pn (GHC.L l decl) = Just True+        workerDecl _ = Nothing++-------------------------------------------------------------------------------+-- |Return True if a PName is a qualified PName.+--  AZ:NOTE: this tests the use instance, the underlying name may be qualified.+--           e.g. used name is zip, GHC.List.zip+--     NOTE2: not sure if this gives a meaningful result for a GHC.Name+isQualifiedPN :: GHC.Name -> RefactGhc Bool+isQualifiedPN name = return $ GHC.isQual $ GHC.nameRdrName name+++-- | Return True if a declaration is a type signature declaration.+isTypeSig :: GHC.LSig a -> Bool+isTypeSig (GHC.L _ (GHC.TypeSig{})) = True+isTypeSig _ = False++-- | Return True if a declaration is a type signature declaration.+isTypeSigDecl :: GHC.LHsDecl a -> Bool+isTypeSigDecl (GHC.L _ (GHC.SigD (GHC.TypeSig{}))) = True+isTypeSigDecl _ = False++-- | Return True if a declaration is a function definition.+isFunBindP :: GHC.LHsDecl GHC.RdrName -> Bool+isFunBindP (GHC.L _ (GHC.ValD (GHC.FunBind{}))) = True+isFunBindP _ =False++isFunBindR::GHC.LHsBind t -> Bool+isFunBindR (GHC.L _l (GHC.FunBind{})) = True+isFunBindR _ =False++-- | Returns True if a declaration is a pattern binding.+isPatBindP :: GHC.LHsDecl GHC.RdrName -> Bool+isPatBindP (GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _))) = True+isPatBindP _=False++isPatBindR :: GHC.LHsBind t -> Bool+isPatBindR (GHC.L _ (GHC.PatBind _ _ _ _ _)) = True+isPatBindR _=False+++-- | Return True if a declaration is a pattern binding which only+-- defines a variable value.+isSimplePatDecl :: GHC.LHsDecl GHC.RdrName -> Bool+isSimplePatDecl decl = case decl of+     (GHC.L _l (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) -> hsNamessRdr p /= []+     _ -> False++-- | Return True if a declaration is a pattern binding which only+-- defines a variable value.+isSimplePatBind :: (GHC.DataId t) => GHC.LHsBind t-> Bool+isSimplePatBind decl = case decl of+     (GHC.L _l (GHC.PatBind p _rhs _ty _fvs _)) -> hsNamessRdr p /= []+     _ -> False++-- | Return True if a declaration is a pattern binding but not a simple one.+isComplexPatDecl::GHC.LHsDecl name -> Bool+isComplexPatDecl (GHC.L l (GHC.ValD decl)) = isComplexPatBind (GHC.L l decl)+isComplexPatDecl _ = False++-- | Return True if a LHsBin is a pattern binding but not a simple one.+isComplexPatBind::GHC.LHsBind name -> Bool+isComplexPatBind decl+  = case decl of+     (GHC.L _l (GHC.PatBind (GHC.L _ (GHC.VarPat _)) _rhs _ty _fvs _)) -> True+     _ -> False++-- | Return True if a declaration is a function\/pattern definition.+isFunOrPatBindP :: HsDeclP -> Bool+isFunOrPatBindP decl = isFunBindP decl || isPatBindP decl++-- | Return True if a declaration is a function\/pattern definition.+isFunOrPatBindR :: GHC.LHsBind t -> Bool+isFunOrPatBindR decl = isFunBindR decl || isPatBindR decl++-- ---------------------------------------------------------------------+++-- | Returns True is a syntax phrase, say a, is part of another syntax+-- phrase, say b.+-- Expects to be at least Parser output+findEntity':: (SYB.Data a, SYB.Data b)+              => a -> b -> Maybe (SimpPos,SimpPos)+findEntity' a b = res+  where+    -- ++AZ++ do a generic traversal, and see if it matches.+    res = SYB.somethingStaged SYB.Parser Nothing worker b++    worker :: (SYB.Data c)+           => c -> Maybe (SimpPos,SimpPos)+    worker x = if SYB.typeOf a == SYB.typeOf x+                 -- then Just (getStartEndLoc b == getStartEndLoc a)+                 then Just (getStartEndLoc x)+                 else Nothing++--------------------------------------------------------------------------------++sameBindRdr :: NameMap -> GHC.LHsDecl GHC.RdrName -> GHC.LHsDecl GHC.RdrName -> Bool+sameBindRdr nm b1 b2 = (definedNamesRdr nm b1) == (definedNamesRdr nm b2)++-- ---------------------------------------------------------------------++-- TODO: is this the same is isUsedInRhs?+class (SYB.Data t) => UsedByRhs t where++    -- | Return True if any of the GHC.Name's appear in the given+    -- syntax element+    usedByRhsRdr :: NameMap -> t -> [GHC.Name] -> Bool++instance UsedByRhs (GHC.HsModule GHC.RdrName) where++   -- Not a meaningful question at this level+   usedByRhsRdr _ _parsed _pns = False++-- -------------------------------------++instance (UsedByRhs a) => UsedByRhs (GHC.Located a) where+   usedByRhsRdr nm (GHC.L _ d) pns = usedByRhsRdr nm d pns++-- -------------------------------------++instance (UsedByRhs a) => UsedByRhs (Maybe a) where+  usedByRhsRdr _  Nothing  _   = False+  usedByRhsRdr nm (Just a) pns = usedByRhsRdr nm a pns++-- -------------------------------------++instance UsedByRhs [GHC.LIE GHC.RdrName] where+    usedByRhsRdr nm ds pns = or $ map (\d -> usedByRhsRdr nm d pns) ds++-- -------------------------------------++instance UsedByRhs (GHC.IE GHC.RdrName) where+   usedByRhsRdr _ _ _ = False++-- -------------------------------------++instance UsedByRhs [GHC.LHsDecl GHC.RdrName] where+  usedByRhsRdr nm ds pns = or $ map (\d -> usedByRhsRdr nm d pns) ds++-- -------------------------------------++instance UsedByRhs (GHC.HsDecl GHC.RdrName) where+  usedByRhsRdr nm de pns =+   case de of+      GHC.TyClD d       -> f d+      GHC.InstD d       -> f d+      GHC.DerivD d      -> f d+      GHC.ValD d        -> f d+      GHC.SigD d        -> f d+      GHC.DefD d        -> f d+      GHC.ForD d        -> f d+      GHC.WarningD d    -> f d+      GHC.AnnD d        -> f d+      GHC.RuleD d       -> f d+      GHC.VectD d       -> f d+      GHC.SpliceD d     -> f d+      GHC.DocD d        -> f d+      GHC.RoleAnnotD d  -> f d+#if __GLASGOW_HASKELL__ < 711+      GHC.QuasiQuoteD d -> f d+#endif+     where+       f d' = usedByRhsRdr nm d' pns++-- -------------------------------------++instance UsedByRhs (GHC.TyClDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.InstDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.DerivDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.ForeignDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.WarnDecls GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.AnnDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.RoleAnnotDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++#if __GLASGOW_HASKELL__ <= 710+instance UsedByRhs (GHC.HsQuasiQuote GHC.RdrName) where+  usedByRhsRdr = assert False undefined+#endif++instance UsedByRhs (GHC.DefaultDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.SpliceDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.VectDecl GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.RuleDecls GHC.RdrName) where+  usedByRhsRdr = assert False undefined++instance UsedByRhs GHC.DocDecl where+  usedByRhsRdr = assert False undefined++instance UsedByRhs (GHC.Sig GHC.RdrName) where+  usedByRhsRdr _ _ _ = False++-- -------------------------------------++instance UsedByRhs (GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where+  usedByRhsRdr nm (GHC.Match _ _ _ (GHC.GRHSs rhs _)) pns+    = findNamesRdr nm pns rhs++-- -------------------------------------++instance UsedByRhs (GHC.HsBind GHC.RdrName) where+#if __GLASGOW_HASKELL__ <= 710+  usedByRhsRdr nm  (GHC.FunBind _ _ matches _ _ _)        pns = findNamesRdr nm pns matches+#else+  usedByRhsRdr nm  (GHC.FunBind _ matches _ _ _)          pns = findNamesRdr nm pns matches+#endif+  usedByRhsRdr nm  (GHC.PatBind _ rhs _ _ _)              pns = findNamesRdr nm pns rhs+  usedByRhsRdr nm  (GHC.PatSynBind (GHC.PSB _ _ _ rhs _)) pns = findNamesRdr nm pns rhs+  usedByRhsRdr nm  (GHC.VarBind _ rhs _)                  pns = findNamesRdr nm pns rhs+  usedByRhsRdr _nm (GHC.AbsBinds _ _ _ _ _)              _pns = False+#if __GLASGOW_HASKELL__ > 710+  usedByRhsRdr _nm (GHC.AbsBindsSig _ _ _ _ _ _)         _pns = False+#endif++-- -------------------------------------++instance UsedByRhs (GHC.HsExpr GHC.RdrName) where+  usedByRhsRdr nm (GHC.HsLet _lb e) pns = findNamesRdr nm pns e+  usedByRhsRdr _ e                 _pns = error $ "undefined usedByRhsRdr:" ++ (showGhc e)++-- -------------------------------------++instance UsedByRhs (GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) where+  usedByRhsRdr nm (GHC.LetStmt lb) pns = findNamesRdr nm pns lb+  usedByRhsRdr _ s               _pns = error $ "undefined usedByRhsRdr:" ++ (showGhc s)++--------------------------------------------------------------------------------++-- |Find the identifier with the given name. This looks through the+-- given syntax phrase for the first GHC.Name which matches. Because+-- it is Renamed source, the GHC.Name will include its defining+-- location. Returns Nothing if the name is not found.++getName::(SYB.Data t)=> String           -- ^ The name to find+                     -> t                -- ^ The syntax phrase+                     -> Maybe GHC.Name   -- ^ The result+getName str t+  = res+  -- ++AZ++:TODO use nameSybQuery?+       where+        res = SYB.somethingStaged SYB.Renamer Nothing+            (Nothing `SYB.mkQ` worker+#if __GLASGOW_HASKELL__ <= 710+                     `SYB.extQ` workerBind+                     `SYB.extQ` workerExpr+#endif+            ) t++        worker ((GHC.L _ n) :: (GHC.Located GHC.Name))+          | showGhcQual n == str = Just n+        worker _ = Nothing++#if __GLASGOW_HASKELL__ <= 710+        workerBind (GHC.L _ (GHC.VarPat name) :: (GHC.Located (GHC.Pat GHC.Name)))+          | showGhcQual name == str = Just name+        workerBind _ = Nothing+++        workerExpr ((GHC.L _ (GHC.HsVar name)) :: (GHC.Located (GHC.HsExpr GHC.Name)))+          | showGhcQual name == str = Just name+        workerExpr _ = Nothing+#endif++-- ---------------------------------------------------------------------++-- | Add identifiers to the export list of a module. If the second argument is+-- like: Just p, then do the adding only if p occurs in the export list, and the+-- new identifiers are added right after p in the export list. Otherwise the new+-- identifiers are add to the beginning of the export list. In the case that the+-- export list is emport, then if the third argument is True, then create an+-- explict export list to contain only the new identifiers, otherwise do+-- nothing.++addImportDecl ::+    GHC.ParsedSource+    -> GHC.ModuleName+#if __GLASGOW_HASKELL__ <= 710+    -> Maybe GHC.FastString -- ^qualifier+#else+    -> Maybe GHC.StringLiteral -- ^qualifier+#endif+    -> Bool -> Bool -> Bool+    -> Maybe String         -- ^alias+    -> Bool+    -> [GHC.RdrName]+    -> RefactGhc GHC.ParsedSource+-- addImportDecl (groupedDecls,imp, b, c) modName pkgQual source safe qualify alias hide idNames+addImportDecl (GHC.L l p) modName pkgQual source safe qualify alias hide idNames+  = do+       let imp = GHC.hsmodImports p+       impDecl <- mkImpDecl+       newSpan <- liftT uniqueSrcSpanT+       let newImp = GHC.L newSpan impDecl+       liftT $ addSimpleAnnT newImp (DP (1,0)) [((G GHC.AnnImport),DP (0,0))]+       return (GHC.L l p { GHC.hsmodImports = (imp++[newImp])})+  where++     alias' = case alias of+                  Just stringName -> Just $ GHC.mkModuleName stringName+                  _               -> Nothing++     mkImpDecl = do+       newSpan1 <- liftT uniqueSrcSpanT+       newSpan2 <- liftT uniqueSrcSpanT+       newEnts <- mkNewEntList idNames+       let lNewEnts = GHC.L newSpan2 newEnts+       -- logm $ "addImportDecl.mkImpDecl:adding anns for:" ++ showGhc lNewEnts+       liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]+       let lmodname = GHC.L newSpan1 modName+       liftT $ addSimpleAnnT lmodname (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+       return $ GHC.ImportDecl+                        { GHC.ideclSourceSrc = Nothing+                        , GHC.ideclName      = lmodname+                        , GHC.ideclPkgQual   = pkgQual+                        , GHC.ideclSource    = source+                        , GHC.ideclSafe      = safe+                        , GHC.ideclQualified = qualify+                        , GHC.ideclImplicit  = False+                        , GHC.ideclAs        = alias'+                        , GHC.ideclHiding    =+                                      (if idNames == [] && hide == False then+                                            Nothing+                                       else+                                            (Just (hide, lNewEnts)))+                        }++-- ---------------------------------------------------------------------++-- | Adding a declaration to the declaration list of the given syntax+-- phrase. If the second argument is Nothing, then the declaration+-- will be added to the beginning of the declaration list, but after+-- the data type declarations is there is any.+addDecl:: (SYB.Data t,SYB.Typeable t)+        => t              -- ^The AST to be updated+        -> Maybe GHC.Name -- ^If this is Just, then the declaration+                          -- will be added right after this+                          -- identifier's definition.+        -> ([GHC.LHsDecl GHC.RdrName],  Maybe Anns)+             -- ^ The declaration with optional signatures to be added, together+             -- with optional Annotations.+        -> RefactGhc t++addDecl parent pn (declSig, mDeclAnns) = do+  logm $ "addDecl:declSig=" ++ showGhc declSig+  case mDeclAnns of+    Nothing -> return ()+    Just declAnns -> -- addRefactAnns declAnns+      liftT $ modifyAnnsT (mergeAnns declAnns)+  case pn of+    Just pn' -> appendDecl   parent pn' declSig+    Nothing  -> addLocalDecl parent     declSig+ where+  setDeclSpacing newDeclSig n c = do+    -- First clear any previous indentation+    mapM_ (\d -> setPrecedingLinesDeclT d 1 0) newDeclSig+    setPrecedingLinesT (ghead "addDecl" newDeclSig) n c+    -- mapM_ (\d -> setPrecedingLinesT d 1 0) (gtail "addDecl" newDeclSig)++  appendDecl :: (SYB.Data t)+      => t        -- ^Original AST+      -> GHC.Name -- ^Name to add the declaration after+      -> [GHC.LHsDecl GHC.RdrName] -- ^declaration and maybe sig+      -> RefactGhc t -- ^updated AST+  appendDecl parent1 pn' newDeclSig = do+    hasDeclsSybTransform workerHsDecls workerBind parent1+    where+      workerHsDecls :: forall t. HasDecls t => t -> RefactGhc t+      workerHsDecls parent' = do+        -- logm $ "addDecl.appendDecl:(pn')=" ++ showGhc pn'+        liftT $ setDeclSpacing newDeclSig 2 0+        nameMap <- getRefactNameMap+        decls <- liftT $ hsDecls parent'+        let+           (before,after) = break (definesDeclRdr nameMap pn') decls++        -- logm $ "addDecl.appendDecl:(before,after)=" ++ showGhc (before,after)+        let (decls1,decls2) = case after of+              [] -> (before,[])+              _  -> (before ++ [ghead "appendDecl14" after],+                     gtail "appendDecl15" after)+        unless (null decls1 || null decls2) $ do liftT $ balanceComments (last decls1) (head decls2)+        liftT $ replaceDecls parent' (decls1++newDeclSig++decls2)++      workerBind :: (GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName))+      workerBind = assert False undefined++  addLocalDecl :: (SYB.Typeable t,SYB.Data t)+               => t -> [GHC.LHsDecl GHC.RdrName]+               -> RefactGhc t+  addLocalDecl parent' newDeclSig = do+    logm $ "addLocalDecl entered"+    -- logDataWithAnns "addLocalDecl.parent'" parent'+    hasDeclsSybTransform workerHasDecls workerBind parent'+    where+      workerDecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+      workerDecls decls = do+         logm $ "workerDecls entered"+         case decls of+           [] -> liftT $ setDeclSpacing newDeclSig 2 0+           ds -> do+             DP (r,c) <- liftT (getEntryDPT (head ds))+             liftT $ setDeclSpacing newDeclSig r c+             liftT $ setPrecedingLinesT (head ds) 2 0+         return (newDeclSig++decls)++      workerHasDecls :: (HasDecls t) => t -> RefactGhc t+      workerHasDecls p = do+         logm $ "workerHasDecls entered"+         decls <- liftT (hsDecls p)+         decls' <- workerDecls decls+         r <- liftT $ replaceDecls p decls'+         return r++      workerBind :: GHC.LHsBind GHC.RdrName -> RefactGhc (GHC.LHsBind GHC.RdrName)+      workerBind b = do+        logm $ "workerBind entered"+        case b of+#if __GLASGOW_HASKELL__ <= 710+          GHC.L l (GHC.FunBind n i (GHC.MG [match] a ptt o) co fvs t) -> do+#else+          GHC.L l (GHC.FunBind n (GHC.MG (GHC.L lm [match]) a ptt o) co fvs t) -> do+#endif+            match' <- workerHasDecls match+#if __GLASGOW_HASKELL__ <= 710+            return (GHC.L l (GHC.FunBind n i (GHC.MG [match'] a ptt o) co fvs t))+#else+            return (GHC.L l (GHC.FunBind n (GHC.MG (GHC.L lm [match']) a ptt o) co fvs t))+#endif+#if __GLASGOW_HASKELL__ <= 710+          GHC.L _ (GHC.FunBind _ _ (GHC.MG _matches _ _ _) _ _ _) -> do+#else+          GHC.L _ (GHC.FunBind _ (GHC.MG _matches _ _ _) _ _ _) -> do+#endif+            error "addDecl:Cannot add a local decl to a FunBind with multiple matches"+          p@(GHC.L _ (GHC.PatBind _pat _rhs _ty _fvs _t)) -> do+            logm $ "workerBind.PatBind entered"+            decls <- liftT (hsDeclsPatBind p)+            decls' <- workerDecls decls+            r <- liftT $ replaceDeclsPatBind p decls'+            return r++          x -> error $ "addLocalDecl.workerBind:not processing:" ++ SYB.showData SYB.Parser 0 x++-- ---------------------------------------------------------------------+--+-- ---------------------------------------------------------------------++rdrNameFromName :: Bool -> GHC.Name -> RefactGhc GHC.RdrName+rdrNameFromName useQual newName = do+  mname <- case (GHC.nameModule_maybe newName) of+      Just (GHC.Module _ mn) -> return mn+      Nothing -> do+        GHC.Module _ mn <- getRefactModule+        return mn++  if useQual+    then return $ GHC.mkRdrQual mname (GHC.nameOccName newName)+    else return $ GHC.mkRdrUnqual     (GHC.nameOccName newName)++-- ---------------------------------------------------------------------++-- | add items to the hiding list of an import declaration which+-- imports the specified module.+addHiding::+     GHC.ModuleName       -- ^ The imported module name+  -> GHC.ParsedSource     -- ^ The current module+  -> [GHC.RdrName]        -- ^ The items to be added+  -> RefactGhc GHC.ParsedSource -- ^ The result+addHiding mn p ns = do+  logm $ "addHiding called for (module,names):" ++ showGhc (mn,ns)+  p' <- addItemsToImport' mn p (Left ns) Hide+  putRefactParsed p' emptyAnns+  return p'++-- --------------------------------------------------------------------++-- | Creates a new entity list for hiding a name in an ImportDecl.+mkNewEntList :: [GHC.RdrName] -> RefactGhc [GHC.LIE GHC.RdrName]+mkNewEntList idNames = do+  case idNames of+    [] -> return []+    _ -> do+      newEntsInit <- mapM (mkNewEnt True) (init idNames)+      newEntsLast <- mkNewEnt False (last idNames)+      return (newEntsInit ++ [newEntsLast])++-- | Creates a new entity for hiding a name in an ImportDecl.+mkNewEnt :: Bool -> GHC.RdrName -> RefactGhc (GHC.LIE GHC.RdrName)+mkNewEnt addCommaAnn pn = do+  newSpan <- liftT uniqueSrcSpanT+  let lpn = GHC.L newSpan pn+  if addCommaAnn+    then liftT $ addSimpleAnnT lpn (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]+    else liftT $ addSimpleAnnT lpn (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+  return (GHC.L newSpan (GHC.IEVar lpn))++-- | Represents the operation type we want to select on addItemsToImport'+data ImportType = Hide     -- ^ Used for addHiding+                | Import   -- ^ Used for addItemsToImport++-- | Add identifiers (given by the third argument) to the explicit entity list+--   in the declaration importing the specified module name. This function does+--   nothing if the import declaration does not have an explicit entity list.+addItemsToImport ::+     GHC.ModuleName        -- ^ The imported module name+  -> Maybe GHC.Name       -- ^ The condition identifier.+  -> Either [GHC.RdrName] [GHC.LIE GHC.RdrName] -- ^ The items to be added+  -> GHC.ParsedSource      -- ^ The current module+  -> RefactGhc GHC.ParsedSource -- ^ The result+addItemsToImport mn mc ns r = addItemsToImport' mn r ns Import++-- | Add identifiers (given by the third argument) to the explicit entity list+--   in the declaration importing the specified module name. If the ImportType+--   argument is Hide, then the items will be added to the "hiding" list. If it+--   is Import, they will be added to the explicit import entries. This function+--   does nothing if the import declaration does not have an explicit entity+--   list and ImportType is Import.+addItemsToImport'::+     GHC.ModuleName       -- ^ The imported module name+  -> GHC.ParsedSource     -- ^ The current module+  -- -> [GHC.RdrName]        -- ^ The items to be added+  -> Either [GHC.RdrName] [GHC.LIE GHC.RdrName] -- ^ The items to be added+--  ->Maybe GHC.Name       -- ^ The condition identifier.+  -> ImportType           -- ^ Whether to hide the names or import them. Uses special data for clarity.+  -> RefactGhc GHC.ParsedSource -- ^ The result+addItemsToImport' serverModName (GHC.L l p) pns impType = do+    let imps = GHC.hsmodImports p+    imps' <- mapM inImport imps+    return $ GHC.L l p {GHC.hsmodImports = imps'}+  where+    isHide = case impType of+             Hide   -> True+             Import -> False++    inImport :: GHC.LImportDecl GHC.RdrName -> RefactGhc (GHC.LImportDecl GHC.RdrName)+    inImport imp@(GHC.L _ (GHC.ImportDecl _st (GHC.L _ modName) _qualify _source _safe isQualified _isImplicit _as h))+      | serverModName == modName  && not isQualified -- && (if isJust pn then findPN (gfromJust "addItemsToImport" pn) h else True)+       = case h of+           Nothing                          -> insertEnts imp []   True+           Just (_isHide, (GHC.L _le ents)) -> insertEnts imp ents False+    inImport x = return x++    insertEnts ::+      GHC.LImportDecl GHC.RdrName+      -> [GHC.LIE GHC.RdrName]+      -> Bool -- True means there are already existing entities+      -> RefactGhc ( GHC.LImportDecl GHC.RdrName )+    insertEnts imp ents isNew = do+        logm $ "addItemsToImport':insertEnts:(imp,ents,isNew):" ++ showGhc (imp,ents,isNew)+        if isNew && not isHide then return imp+         else do+            logm $ "addItemsToImport':insertEnts:doing stuff"+            newSpan <- liftT uniqueSrcSpanT+            -- newEnts <- mkNewEntList pns+            newEnts <- case pns of+                            Left pns'  -> mkNewEntList pns'+                            Right pns' -> return pns'+            let lNewEnts = GHC.L newSpan (ents++newEnts)+            logm $ "addImportDecl.mkImpDecl:adding anns for:" ++ showGhc lNewEnts+            if isHide+              then+                liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]+              else+                liftT $ addSimpleAnnT lNewEnts (DP (0,1)) [((G GHC.AnnOpenP),DP (0,0)),((G GHC.AnnCloseP),DP (0,0))]+            when (not (null ents)) $ do liftT (addTrailingCommaT (last ents))+            return (replaceHiding imp  (Just (isHide, lNewEnts)))+++    replaceHiding (GHC.L l1 (GHC.ImportDecl st mn q src safe isQ isImp as _h)) h1 =+                  (GHC.L l1 (GHC.ImportDecl st mn q src safe isQ isImp as h1))++-- ---------------------------------------------------------------------++addParamsToSigs :: [GHC.Name] -> GHC.LSig GHC.RdrName -> RefactGhc (GHC.LSig GHC.RdrName)+addParamsToSigs [] ms = return ms+#if __GLASGOW_HASKELL__ <= 710+addParamsToSigs newParams (GHC.L l (GHC.TypeSig lns ltyp pns)) = do+#else+addParamsToSigs newParams (GHC.L l (GHC.TypeSig lns (GHC.HsIB ivs (GHC.HsWC wcs mwc ltyp)))) = do+#endif+  logm $ "addParamsToSigs:newParams=" ++ showGhc newParams+  mts <- mapM getTypeForName newParams+  let ts = catMaybes mts+  logm $ "addParamsToSigs:ts=" ++ showGhc ts+  logDataWithAnns "addParamsToSigs:ts=" ts+  let newStr = ":: " ++ (intercalate " -> " $ map printSigComponent ts) ++ " -> "+  logm $ "addParamsToSigs:newStr=[" ++ newStr ++ "]"+  typ' <- liftT $ foldlM addOneType ltyp (reverse ts)+  sigOk <- isNewSignatureOk ts+  logm $ "addParamsToSigs:(sigOk,newStr)=" ++ show (sigOk,newStr)+  if sigOk+#if __GLASGOW_HASKELL__ <= 710+    then return (GHC.L l (GHC.TypeSig lns typ' pns))+#else+    then return (GHC.L l (GHC.TypeSig lns (GHC.HsIB ivs (GHC.HsWC wcs mwc typ'))))+#endif+    else error $ "\nNew type signature may fail type checking: " ++ newStr ++ "\n"+  where+    addOneType :: GHC.LHsType GHC.RdrName -> GHC.Type -> Transform (GHC.LHsType GHC.RdrName)+    addOneType et t = do+      hst <- typeToLHsType t+      ss1 <- uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+      hst1 <- case t of+        (GHC.FunTy _ _) -> do+          ss <- uniqueSrcSpanT+          let t1 = GHC.L ss (GHC.HsParTy hst)+          setEntryDPT hst (DP (0,0))+          addSimpleAnnT t1  (DP (0,0)) [((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]+          return t1+        _ -> return hst+      let typ = GHC.L ss1 (GHC.HsFunTy hst1 et)++      addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]+#else+      hst1 <- case t of+         -- GHC 8: (ForAllTy (Anon arg) res used to be called FunTy arg res.)+        (GHC.ForAllTy (GHC.Anon _) _) -> do+          ss <- uniqueSrcSpanT+          let t1 = GHC.L ss (GHC.HsParTy hst)+          setEntryDPT hst (DP (0,0))+          addSimpleAnnT t1  (DP (0,0)) [((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]+          return t1+        _ -> return hst+      let typ = GHC.L ss1 (GHC.HsFunTy hst1 et)++      -- let typ = error $ "addParamsToSigs:need to update for GHC 8:hst=" ++ SYB.showData SYB.Parser 0 hst+      -- let typ = GHC.L ss1 (GHC.HsFunTy hst et)++      addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]+#endif+      return typ++    printSigComponent :: GHC.Type -> String+    printSigComponent x = ppType x++addParamsToSigs np ls = error $ "addParamsToSigs: no match for:" ++ showGhc (np,ls)++-- ---------------------------------------------------------------------++-- |Fail any signature having a forall in it.+-- TODO: this is unnecesarily restrictive, but needs+-- a) proper reversing of GHC.Type to GHC.LhsType+-- b) some serious reverse type inference to ensure that the+--    constraints are modified properly to merge the old signature+--    part and the new.+isNewSignatureOk :: [GHC.Type] -> RefactGhc Bool+isNewSignatureOk types = do+  logm $ "isNewSignatureOk:types=" ++ SYB.showData SYB.Parser 0 types+  -- NOTE: under some circumstances enabling Rank2Types or RankNTypes+  --       can resolve the type conflict, this can potentially be checked+  --       for.+  -- NOTE2: perhaps proceed and reload the tentative refactoring into+  --        the GHC session and accept it only if it type checks++  -- GHC 8: (ForAllTy (Anon arg) res used to be called FunTy arg res.)++  let+    r = SYB.everythingStaged SYB.TypeChecker (++) []+          ([] `SYB.mkQ` usesForAll) types+#if __GLASGOW_HASKELL__ <= 710+    usesForAll (GHC.ForAllTy _ _) = [1::Int]+#else+    usesForAll (GHC.ForAllTy (GHC.Named _ _) _) = [1::Int]+#endif+    usesForAll _                  = []++  return $ emptyList r++-- ---------------------------------------------------------------------++-- TODO: complete this+typeToLHsType :: GHC.Type -> Transform (GHC.LHsType GHC.RdrName)+typeToLHsType (GHC.TyVarTy v)   = do+  ss <- uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+  let typ = GHC.L ss (GHC.HsTyVar (GHC.nameRdrName $ Var.varName v))+#else+  let typ = GHC.L ss (GHC.HsTyVar (GHC.L ss (GHC.nameRdrName $ Var.varName v)))+#endif+  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+  return typ++typeToLHsType (GHC.AppTy t1 t2) = do+  t1' <- typeToLHsType t1+  t2' <- typeToLHsType t2+  ss <- uniqueSrcSpanT+  return $ GHC.L ss (GHC.HsAppTy t1' t2')++typeToLHsType t@(GHC.TyConApp _tc _ts) = tyConAppToHsType t++#if __GLASGOW_HASKELL__ <= 710+typeToLHsType (GHC.FunTy t1 t2) = do+  t1' <- typeToLHsType t1+  t2' <- typeToLHsType t2+  ss <- uniqueSrcSpanT+  let typ = GHC.L ss (GHC.HsFunTy t1' t2')+  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]+  return typ+#else+-- GHC 8: (ForAllTy (Anon arg) res used to be called FunTy arg res.)+typeToLHsType (GHC.ForAllTy (GHC.Anon t1) t2) = do+  t1' <- typeToLHsType t1+  t2' <- typeToLHsType t2+  ss <- uniqueSrcSpanT+  let typ = GHC.L ss (GHC.HsFunTy t1' t2')+  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnRarrow),DP (0,1))]+  return typ+#endif++typeToLHsType (GHC.ForAllTy _v t) = do+  t' <- typeToLHsType t+  ss1 <- uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+  ss2 <- uniqueSrcSpanT+  return $ GHC.L ss1 (GHC.HsForAllTy GHC.Explicit Nothing (GHC.HsQTvs [] []) (GHC.L ss2 []) t')+#else+  return $ GHC.L ss1 (GHC.HsForAllTy [] t')+#endif++typeToLHsType (GHC.LitTy (GHC.NumTyLit i)) = do+  ss <- uniqueSrcSpanT+  let typ = GHC.L ss (GHC.HsTyLit (GHC.HsNumTy (show i) i)) :: GHC.LHsType GHC.RdrName+  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+  return typ++typeToLHsType (GHC.LitTy (GHC.StrTyLit s)) = do+  ss <- uniqueSrcSpanT+  let typ = GHC.L ss (GHC.HsTyLit (GHC.HsStrTy "" s)) :: GHC.LHsType GHC.RdrName+  addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+  return typ+++{-+data Type+  = TyVarTy Var	-- ^ Vanilla type or kind variable (*never* a coercion variable)++  | AppTy         -- See Note [AppTy invariant]+	Type+	Type		-- ^ Type application to something other than a 'TyCon'. Parameters:+	                --+                        --  1) Function: must /not/ be a 'TyConApp',+                        --     must be another 'AppTy', or 'TyVarTy'+	                --+	                --  2) Argument type++  | TyConApp      -- See Note [AppTy invariant]+	TyCon+	[KindOrType]	-- ^ Application of a 'TyCon', including newtypes /and/ synonyms.+	                -- Invariant: saturated appliations of 'FunTyCon' must+	                -- use 'FunTy' and saturated synonyms must use their own+                        -- constructors. However, /unsaturated/ 'FunTyCon's+                        -- do appear as 'TyConApp's.+	                -- Parameters:+	                --+	                -- 1) Type constructor being applied to.+	                --+                        -- 2) Type arguments. Might not have enough type arguments+                        --    here to saturate the constructor.+                        --    Even type synonyms are not necessarily saturated;+                        --    for example unsaturated type synonyms+	                --    can appear as the right hand side of a type synonym.++  | FunTy+	Type+	Type		-- ^ Special case of 'TyConApp': @TyConApp FunTyCon [t1, t2]@+			-- See Note [Equality-constrained types]++  | ForAllTy+	Var         -- Type or kind variable+	Type	        -- ^ A polymorphic type++  | LitTy TyLit     -- ^ Type literals are simillar to type constructors.++-}++tyConAppToHsType :: GHC.Type -> Transform (GHC.LHsType GHC.RdrName)+tyConAppToHsType (GHC.TyConApp tc _ts) = r (show $ GHC.tyConName tc)+  where+    r str = do+      ss <- uniqueSrcSpanT+      let typ = GHC.L ss (GHC.HsTyLit (GHC.HsStrTy str $ GHC.mkFastString str)) :: GHC.LHsType GHC.RdrName+      addSimpleAnnT typ (DP (0,0)) [((G GHC.AnnVal),DP (0,1))]+      return typ++-- tyConAppToHsType t@(GHC.TyConApp _tc _ts)+--    = error $ "tyConAppToHsType: unexpected:" ++ (SYB.showData SYB.TypeChecker 0 t)++{-+HsType+HsForAllTy HsExplicitFlag (LHsTyVarBndrs name) (LHsContext name) (LHsType name)+HsTyVar name+HsAppTy (LHsType name) (LHsType name)+HsFunTy (LHsType name) (LHsType name)+HsListTy (LHsType name)+HsPArrTy (LHsType name)+HsTupleTy HsTupleSort [LHsType name]+HsOpTy (LHsType name) (LHsTyOp name) (LHsType name)+HsParTy (LHsType name)+HsIParamTy HsIPName (LHsType name)+HsEqTy (LHsType name) (LHsType name)+HsKindSig (LHsType name) (LHsKind name)+HsQuasiQuoteTy (HsQuasiQuote name)+HsSpliceTy (HsSplice name) FreeVars PostTcKind+HsDocTy (LHsType name) LHsDocString+HsBangTy HsBang (LHsType name)+HsRecTy [ConDeclField name]+HsCoreTy Type+HsExplicitListTy PostTcKind [LHsType name]+HsExplicitTupleTy [PostTcKind] [LHsType name]+HsTyLit HsTyLit+HsWrapTy HsTyWrapper (HsType name)+-}++-- ---------------------------------------------------------------------++addParamsToDecls::+         [GHC.LHsDecl GHC.RdrName] -- ^ A declaration list where the function is defined and\/or used.+      -> GHC.Name       -- ^ The function name.+      -> [GHC.RdrName]  -- ^ The parameters to be added.+      -> RefactGhc [GHC.LHsDecl GHC.RdrName] -- ^ The result.++addParamsToDecls decls pn paramPNames = do+  logm $ "addParamsToDecls (pn,paramPNames)=" ++ (showGhc (pn,paramPNames))+  nameMap <- getRefactNameMap+  if (paramPNames /= [])+        then mapM (addParamToDecl nameMap) decls+        else return decls+  where+   addParamToDecl :: NameMap -> GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+   addParamToDecl nameMap (GHC.L l1 (GHC.ValD (GHC.FunBind lp@(GHC.L l2 pname) i (GHC.MG matches a ptt o) co fvs t)))+#else+   addParamToDecl nameMap (GHC.L l1 (GHC.ValD (GHC.FunBind lp@(GHC.L l2 pname) (GHC.MG (GHC.L lm matches) a ptt o) co fvs t)))+#endif+    | eqRdrNamePure nameMap lp pn+    = do+         matches' <- mapM addParamtoMatch matches+#if __GLASGOW_HASKELL__ <= 710+         return (GHC.L l1 (GHC.ValD (GHC.FunBind (GHC.L l2 pname) i (GHC.MG matches' a ptt o) co fvs t)))+#else+         return (GHC.L l1 (GHC.ValD (GHC.FunBind (GHC.L l2 pname) (GHC.MG (GHC.L lm matches') a ptt o) co fvs t)))+#endif+      where+       addParamtoMatch (GHC.L l (GHC.Match fn1 pats mtyp rhs))+        = do+             rhs' <- addActualParamsToRhs pn paramPNames rhs+             pats' <- liftT $ mapM addParam paramPNames+             -- logDataWithAnns "addParamToDecl.addParam:pats'" pats'+             return (GHC.L l (GHC.Match fn1 (pats'++pats) mtyp rhs'))++   -- TODO: The following will never match, as a PatBind only deals with complex patterns.+   addParamToDecl _nameMap x@(GHC.L _l1 (GHC.ValD (GHC.PatBind _pat@(GHC.L _l2 (GHC.VarPat _p)) _rhs _ty _fvs _t)))+     = return x+   addParamToDecl _ x = return x++   addParam n = do+     newSpan <- uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+     let vn = (GHC.L newSpan (GHC.VarPat n))+#else+     let vn = (GHC.L newSpan (GHC.VarPat (GHC.L newSpan n)))+#endif+     addSimpleAnnT vn (DP (0,1)) [((G GHC.AnnVal),DP (0,0))]+     return vn++-- ---------------------------------------------------------------------++-- ++AZ++: This looks like it is trying to do too many things+-- | Add identifiers to the export list of a module. If the second argument+-- is like: Just p, then do the adding only if p occurs in the export list, and+-- the new identifiers are added right after p in the export list. Otherwise the+-- new identifiers are add to the beginning of the export list. In the case that+-- the export list is empty, then if the third argument is True, then create an+-- explict export list to contain only the new identifiers, otherwise do+-- nothing.+-- TODO:AZ: re-arrange params to line up with addItemsToExport+addItemsToExport ::+                    GHC.ParsedSource                    -- ^The module AST.+                   -> Maybe GHC.Name                    -- ^The condtion identifier.+                   -> Bool                              -- ^Create an explicit list or not+                   -> Either [GHC.RdrName] [GHC.LIE GHC.RdrName]+                            -- ^The identifiers to add in either String or HsExportEntP format.+                   -> RefactGhc GHC.ParsedSource        -- ^The result.+addItemsToExport modu _  _ (Left [])  = return modu+addItemsToExport modu _  _ (Right []) = return modu+-- addItemsToExport modu@(HsModule loc modName exps imps ds) (Just pn) _ ids+addItemsToExport modu@(GHC.L l (GHC.HsModule modName exps imps ds deps hs)) (Just pn) _ ids+  =  case exps  of+       Just (GHC.L le ents) -> do+                   logm $ "addItemsToExport:pn=" ++ showGhc pn+                   nm <- getRefactNameMap+                   let (e1,e2) = break (findLRdrName nm pn) ents+                   if e2 /= []+                        then do+                           es <- case ids of+                             Left is' -> mkNewEntList is'+                             Right es' -> return es'+                           let e = (ghead "addVarItemInExport" e2)+                               lNewEnts = GHC.L le (e1++(e:es)++tail e2)+                           liftT (addTrailingCommaT e)+                           return (GHC.L l (GHC.HsModule modName (Just lNewEnts) imps ds deps hs))+                        -- then do ((toks,_),others)<-get+                        --         let e = (ghead "addVarItemInExport" e2)+                        --             es = case ids of+                        --                   (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+                        --                   (Right es') -> es'+                        --         let (_,endPos) = getStartEndLoc toks e+                        --             (t, (_,s)) = ghead "addVarItemInExport" $ getToks (endPos,endPos) toks+                        --             newToken = mkToken t endPos (s++","++ showEntities (render.ppi) es)+                        --             toks' = replaceToks toks endPos endPos [newToken]+                        --         put ((toks',modified),others)+                        --         return (HsModule loc modName (Just (e1++(e:es)++tail e2)) imps ds)+                        else return modu+       Nothing   -> return modu++addItemsToExport (GHC.L l (GHC.HsModule _ (Just ents) _ _ _ _)) Nothing createExp ids+  = assert False undefined+    -- = do ((toks,_),others)<-get+    --      let es = case ids of+    --                 (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+    --                 (Right es') -> es'+    --          (t, (pos,s))=fromJust $ find isOpenBracket toks  -- s is the '('+    --          newToken = if ents /=[] then  (t, (pos,(s++showEntities (render.ppi) es++",")))+    --                                  else  (t, (pos,(s++showEntities (render.ppi) es)))+    --          pos'= simpPos pos+    --          toks' = replaceToks toks pos' pos' [newToken]+    --      put ((toks',modified),others)+    --      return modu {hsModExports=Just (es++ ents)}++-- addItemsToExport mod@(HsModule _  (SN modName (SrcLoc _ c row col))  Nothing _ _)  Nothing createExp ids+addItemsToExport modu@(GHC.L l (GHC.HsModule modName Nothing _ _ _ _))  Nothing createExp ids+  = assert False undefined+  -- =case createExp of+  --      True ->do ((toks,_),others)<-get+  --                let es = case ids of+  --                              (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+  --                              (Right es') -> es'+  --                    pos = (row,col)+  --                    newToken = mkToken Varid pos (modNameToStr modName++ "("+  --                                        ++ showEntities (render.ppi) es++")")+  --                    toks' = replaceToks toks pos pos [newToken]+  --                put  ((toks', modified), others)+  --                return modu {hsModExports=Just es}+  --      False ->return modu+++{-+-- | Add identifiers to the export list of a module. If the second argument is like: Just p, then do the adding only if p occurs+-- in the export list, and the new identifiers are added right after p in the export list. Otherwise the new identifiers are add+-- to the beginning of the export list. In the case that the export list is emport, then if the third argument is True, then create+-- an explict export list to contain only the new identifiers, otherwise do nothing.+{-+addItemsToExport::( )+                 => HsModuleP                           -- The module AST.+                   -> Maybe PName                       -- The condtion identifier.+                   -> Bool                              -- Create an explicit list or not+                   -> Either [String] [HsExportEntP]    -- The identifiers to add in either String or HsExportEntP format.+                   -> m HsModuleP                       -- The result.+-}++addItemsToExport::(MonadState (([PosToken],Bool), t1) m)+                 => HsModuleP                           -- The module AST.+                   -> Maybe PName                       -- The condtion identifier.+                   -> Bool                              -- Create an explicit list or not+                   -> Either [String] [HsExportEntP]    -- The identifiers to add in either String or HsExportEntP format.+                   -> m HsModuleP                       -- The result.+++addItemsToExport mod _  _ (Left [])  = return mod+addItemsToExport mod _  _ (Right []) = return mod+addItemsToExport mod@(HsModule loc modName exps imps ds) (Just pn) _ ids+  =  case exps  of+       Just ents ->let (e1,e2) = break (findEntity pn) ents+                   in if e2 /=[]+                        then do ((toks,_),others)<-get+                                let e = (ghead "addVarItemInExport" e2)+                                    es = case ids of+                                          (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+                                          (Right es') -> es'+                                let (_,endPos) = getStartEndLoc toks e+                                    (t, (_,s)) = ghead "addVarItemInExport" $ getToks (endPos,endPos) toks+                                    newToken = mkToken t endPos (s++","++ showEntities (render.ppi) es)+                                    toks' = replaceToks toks endPos endPos [newToken]+                                put ((toks',modified),others)+                                return (HsModule loc modName (Just (e1++(e:es)++tail e2)) imps ds)+                        else return mod+       Nothing   -> return mod++addItemsToExport mod@(HsModule _ _ (Just ents) _ _) Nothing createExp ids+    = do ((toks,_),others)<-get+         let es = case ids of+                    (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+                    (Right es') -> es'+             (t, (pos,s))=fromJust $ find isOpenBracket toks  -- s is the '('+             newToken = if ents /=[] then  (t, (pos,(s++showEntities (render.ppi) es++",")))+                                     else  (t, (pos,(s++showEntities (render.ppi) es)))+             pos'= simpPos pos+             toks' = replaceToks toks pos' pos' [newToken]+         put ((toks',modified),others)+         return mod {hsModExports=Just (es++ ents)}++addItemsToExport mod@(HsModule _  (SN modName (SrcLoc _ c row col))  Nothing _ _)  Nothing createExp ids+  =case createExp of+       True ->do ((toks,_),others)<-get+                 let es = case ids of+                               (Left is' ) ->map (\x-> (EntE (Var (nameToPNT x)))) is'+                               (Right es') -> es'+                     pos = (row,col)+                     newToken = mkToken Varid pos (modNameToStr modName++ "("+                                         ++ showEntities (render.ppi) es++")")+                     toks' = replaceToks toks pos pos [newToken]+                 put  ((toks', modified), others)+                 return mod {hsModExports=Just es}+       False ->return mod+-}+-- ---------------------------------------------------------------------++addActualParamsToRhs :: (SYB.Data t) =>+                        GHC.Name -> [GHC.RdrName] -> t -> RefactGhc t+addActualParamsToRhs pn paramPNames rhs = do+    logm $ "addActualParamsToRhs:entered:(pn,paramPNames)=" ++ showGhc (pn,paramPNames)+    nameMap <- getRefactNameMap+    let+       worker :: (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LHsExpr GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+       worker oldExp@(GHC.L l2 (GHC.HsVar pname))+#else+       worker oldExp@(GHC.L l2 (GHC.HsVar (GHC.L _ pname)))+#endif+        | eqRdrNamePure nameMap (GHC.L l2 pname) pn+          = do+              logDataWithAnns "addActualParamsToRhs:oldExp=" oldExp+              newExp' <- foldlM addParamToExp oldExp paramPNames++              edp <- liftT $ getEntryDPT oldExp+              liftT $ setEntryDPT oldExp (DP (0,0))+              l2' <- liftT $ uniqueSrcSpanT+              let newExp  = (GHC.L l2' (GHC.HsPar newExp'))+              liftT $ addSimpleAnnT newExp (DP (0,0)) [(G GHC.AnnOpenP,DP (0,0)),(G GHC.AnnCloseP,DP (0,0))]+              liftT $ setEntryDPT newExp edp+              return newExp+       worker x = return x++       addParamToExp :: (GHC.LHsExpr GHC.RdrName) -> GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+       addParamToExp expr param = do+         ss1 <- liftT $ uniqueSrcSpanT+         ss2 <- liftT $ uniqueSrcSpanT+         logm $ "addActualParamsToRhs.addParamsToExp:(ss1,ss2):" ++ showGhc (ss1,ss2)+         registerRdrName (GHC.L ss2 param)+#if __GLASGOW_HASKELL__ <= 710+         let var   = GHC.L ss2 (GHC.HsVar param)+#else+         let var   = GHC.L ss2 (GHC.HsVar (GHC.L ss2 param))+#endif+         liftT $ addSimpleAnnT var (DP (0,0)) [(G GHC.AnnVal,DP (0,1))]+         let expr' = GHC.L ss1 (GHC.HsApp expr var)+         liftT $ addSimpleAnnT expr' (DP (0,0)) []+         return expr'++    r <- applyTP (full_buTP (idTP  `adhocTP` worker)) rhs+    return r++{-++The code++    sumSqu (x:xs) = (sq bar2) x + sumSquares xs++results in++          (GRHSs +           [+            ({ LiftToToplevel/D1.hs:(13,15)-(15,16) }+             Just (Ann (DP (0,-1)) [] [] [] Nothing Nothing)+             (GRHS +              [] +              ({ LiftToToplevel/D1.hs:13:17-43 }+               Just (Ann (DP (0,1)) [] [] [] Nothing Nothing)+               (OpApp +                ({ LiftToToplevel/D1.hs:13:17-27 }+                 Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)+                 (HsApp +                  ({ LiftToToplevel/D1.hs:13:17-25 }+                   Just (Ann (DP (0,0)) [] [] [((G AnnOpenP),DP (0,0)),((G AnnCloseP),DP (0,0))] Nothing Nothing)+                   (HsPar +                    ({ LiftToToplevel/D1.hs:13:18-24 }+                     Just (Ann (DP (0,0)) [] [] [] Nothing Nothing)+                     (HsApp +                      ({ LiftToToplevel/D1.hs:13:18-19 }+                       Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                       (HsVar +                        (Unqual {OccName: sq}))) +                      ({ LiftToToplevel/D1.hs:13:21-24 }+                       Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                       (HsVar +                        (Unqual {OccName: bar2}))))))) +                  ({ LiftToToplevel/D1.hs:13:27 }+                   Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                   (HsVar +                    (Unqual {OccName: x}))))) +                ({ LiftToToplevel/D1.hs:13:29 }+                 Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                 (HsVar +                  (Unqual {OccName: +}))) +                (PlaceHolder) +                ({ LiftToToplevel/D1.hs:13:31-43 }+                 Just (Ann (DP (0,1)) [] [] [] Nothing Nothing)+                 (HsApp +                  ({ LiftToToplevel/D1.hs:13:31-40 }+                   Just (Ann (DP (0,0)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                   (HsVar +                    (Unqual {OccName: sumSquares}))) +                  ({ LiftToToplevel/D1.hs:13:42-43 }+                   Just (Ann (DP (0,1)) [] [] [((G AnnVal),DP (0,0))] Nothing Nothing)+                   (HsVar +                    (Unqual {OccName: xs})))))))))] ++-}+{-+Required end result : (sq pow) x + sumSquares xs++                (L {test/testdata/LiftToToplevel/D2.hs:6:21-46}+                 (OpApp++                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-30}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-28}+                     (HsPar+                      (L {test/testdata/LiftToToplevel/D2.hs:6:22-27}+                       (HsApp+                        (L {test/testdata/LiftToToplevel/D2.hs:6:22-23}+                         (HsVar {Name: LiftToToplevel.D2.sq}))+                        (L {test/testdata/LiftToToplevel/D2.hs:6:25-27}+                         (HsVar {Name: pow}))))))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:30}+                     (HsVar {Name: x}))))++                  (L {test/testdata/LiftToToplevel/D2.hs:6:32}+                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}+                  (L {test/testdata/LiftToToplevel/D2.hs:6:34-46}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:34-43}+                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:45-46}+                     (HsVar {Name: xs}))))))))]++Alternate, no parens : sq pow x + sumSquares xs++                (L {test/testdata/LiftToToplevel/D2.hs:6:21-44}+                 (OpApp++                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-28}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-26}+                     (HsApp+                      (L {test/testdata/LiftToToplevel/D2.hs:6:21-22}+                       (HsVar {Name: LiftToToplevel.D2.sq}))+                      (L {test/testdata/LiftToToplevel/D2.hs:6:24-26}+                       (HsVar {Name: pow}))))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:28}+                     (HsVar {Name: x}))))+++                  (L {test/testdata/LiftToToplevel/D2.hs:6:30}+                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}+                  (L {test/testdata/LiftToToplevel/D2.hs:6:32-44}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:32-41}+                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:43-44}+                     (HsVar {Name: xs}))))))))]+++Original : sq x + sumSquares xs++                (L {test/testdata/LiftToToplevel/D2.hs:6:21-40}+                 (OpApp++                  (L {test/testdata/LiftToToplevel/D2.hs:6:21-24}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:21-22}+                     (HsVar {Name: sq}))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:24}+                     (HsVar {Name: x}))))+++                  (L {test/testdata/LiftToToplevel/D2.hs:6:26}+                   (HsVar {Name: GHC.Num.+})) {Fixity: infixl 6}+                  (L {test/testdata/LiftToToplevel/D2.hs:6:28-40}+                   (HsApp+                    (L {test/testdata/LiftToToplevel/D2.hs:6:28-37}+                     (HsVar {Name: LiftToToplevel.D2.sumSquares}))+                    (L {test/testdata/LiftToToplevel/D2.hs:6:39-40}+                     (HsVar {Name: xs}))))))))]++-}++-- ---------------------------------------------------------------------++-- | Duplicate a function\/pattern binding declaration under a new name+-- right after the original one.+duplicateDecl ::+    [GHC.LHsDecl GHC.RdrName] -- ^ decls to be updated, containing the original decl (and sig)+  ->GHC.Name            -- ^ The identifier whose definition is to be duplicated+  ->GHC.Name            -- ^ The new name (possibly qualified)+  ->RefactGhc [GHC.LHsDecl GHC.RdrName]  -- ^ The result+duplicateDecl decls n newFunName+ = do+     logm $ "duplicateDecl entered:(decls,n,newFunName)=" ++ showGhc (decls,n,newFunName)+     nm <- getRefactNameMap+     let+       declsToDup = definingDeclsRdrNames nm [n] decls True False+       funBinding = filter isFunOrPatBindP declsToDup     --get the fun binding.+       typeSig    = map wrapSig $ definingSigsRdrNames nm [n] decls+     funBinding'' <- renamePN n newFunName PreserveQualify funBinding+     typeSig'' <- renamePN n newFunName PreserveQualify typeSig+     logm $ "duplicateDecl:funBinding''=" ++ showGhc funBinding''++     funBinding3 <- mapM (\f@(GHC.L _ fb) -> do+                             newSpan <- liftT uniqueSrcSpanT+                             let fb' = GHC.L newSpan fb+                             liftT $ modifyAnnsT (copyAnn f fb')+                             return fb'+                             ) (typeSig'' ++ funBinding'')+     when (not $ null funBinding3) $ do+                             liftT $ setEntryDPT (head funBinding3) (DP (2,0))+                             liftT $ mapM_ (\d -> setEntryDPT d (DP (1,0))) (tail funBinding3)+     let (decls1,decls2) = break (definesDeclRdr nm n) decls+         (declsToDup',declsRest) = break (not . definesDeclRdr nm n) decls2+     -- logDataWithAnns "duplicateDecl:funBinding3" funBinding3+     return $ decls1 ++ declsToDup' ++ funBinding3 ++ declsRest++-- ---------------------------------------------------------------------+-- |Divide a declaration list into three parts (before, parent, after)+-- according to the PNT, where 'parent' is the first decl containing+-- the PNT, 'before' are those decls before 'parent' and 'after' are+-- those decls after 'parent'.+divideDecls :: SYB.Data t =>+  [t] -> GHC.Located GHC.Name -> RefactGhc ([t], [t], [t])+divideDecls ds (GHC.L _ pnt) = do+  nm <- getRefactNameMap+  let (before,after) = break (\x -> findNameInRdr nm pnt x) ds+  return $ if (not $ emptyList after)+         then (before, [ghead "divideDecls" after], gtail "divideDecls" after)+         else (ds,[],[])++-- ---------------------------------------------------------------------++-- | Remove the declaration (and the type signature is the second+-- parameter is True) that defines the given identifier from the+-- declaration list.+rmDecl:: (SYB.Data t)+    => GHC.Name     -- ^ The identifier whose definition is to be removed.+    -> Bool         -- ^ True means including the type signature.+    -> t            -- ^ The AST fragment containting the declarations,+                    -- originating from the ParsedSource+    -> RefactGhc+        (t,+        GHC.LHsDecl GHC.RdrName,+        Maybe (GHC.LSig GHC.RdrName))  -- ^ The result and the removed declaration+                                       -- and the possibly removed siganture++rmDecl pn incSig t = do+  setStateStorage StorageNone+  t' <- everywhereMStaged' SYB.Parser (SYB.mkM   inModule+                                      `SYB.extM` inLet+                                      `SYB.extM` inMatch+                                      ) t -- top down+         -- applyTP (once_tdTP (failTP `adhocTP` inBinds)) t+  storage <- getStateStorage+  let decl' = case storage of+                StorageDeclRdr decl -> decl+                x                   -> error $ "rmDecl: unexpected value in StateStorage:" ++ (show x)+  setStateStorage StorageNone+  (t'',sig') <- if incSig+                  then rmTypeSig pn t'+                  else return (t', Nothing)+  return (t'',decl',sig')+  where+    inModule (p :: GHC.ParsedSource)+      = doRmDeclList p++    inMatch x@(((GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))):: (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)))+      = doRmDeclList x++    inLet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+    inLet letExpr@(GHC.L _ (GHC.HsLet _localDecls expr))+      = do+         isDone <- getDone+         if isDone+           then return letExpr+           else do+             nameMap <- getRefactNameMap+             -- decls <- liftT $ hsDecls localDecls+             decls <- liftT $ hsDecls letExpr+             let (decls1,decls2) = break (definesDeclRdr nameMap pn) decls+             if not $ emptyList decls2+                then do+                  let decl = ghead "rmDecl" decls2+                  setStateStorage (StorageDeclRdr decl)+                  case length decls of+                    1 -> do -- Removing the last declaration+                     return expr+                    _ -> do+                     -- logm $ "rmDecl.inLet:length decls /= 1"+                     decls' <- doRmDecl decls1 decls2+                     letExpr' <- liftT $ replaceDecls letExpr decls'+                     return letExpr'+                else do+                  -- liftT $ replaceDecls localDecls decls+                  return letExpr+    inLet x = return x++    -- ---------------------------------++    doRmDeclList parent+      = do+         isDone <- getDone+         -- logm $ "doRmDeclList:isDone=" ++ show isDone+         -- logm $ "doRmDeclList:parent=" ++ SYB.showData SYB.Parser 0 parent+         if isDone+           then return parent+           else do+             nameMap <- getRefactNameMap+             decls <- liftT $ hsDecls parent+             let (decls1,decls2) = break (definesDeclRdr nameMap pn) decls+             if not (null decls2)+               then do+                 -- logDataWithAnns "doRmDeclList:(parent)" (parent)+                 let decl = ghead "doRmDeclList" decls2+                 setStateStorage (StorageDeclRdr decl)+                 decls'  <- doRmDecl decls1 decls2+                 parent' <- liftT $ replaceDecls parent decls'+                 -- logDataWithAnns "doRmDeclList:(parent')" (parent')+                 return parent'+               else do+                 return parent++    -- ---------------------------------++    getDone = do+      s <- getStateStorage+      case s of+        StorageNone -> return False+        _           -> return True++-- ---------------------------------------------------------------------++-- ++AZ++ TODO: I think this has been superseded by hasDeclsSybTransform+declsSybTransform :: (SYB.Typeable a)+  => (forall b. HasDecls b => b -> RefactGhc b)+  -> a -> RefactGhc a+declsSybTransform transform = mt+  where+    mt = SYB.mkM inMatch+         `SYB.extM` inPatDecl+         `SYB.extM` inModule+         `SYB.extM` inHsLet++    inModule :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource+    inModule (modu :: GHC.ParsedSource)+       = transform modu++    inMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+    inMatch x@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))+       = transform x++    inPatDecl ::GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)+    inPatDecl (GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _)))+       -- = transform x+       = error $ "declsSybTransform:need to reimplement PatBind case"+    inPatDecl x = return x++    inHsLet :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+    inHsLet x@(GHC.L _ (GHC.HsLet{}))+       = transform x+    inHsLet x = return x++ ---------------------------------------------------------------------++-- |Utility function to remove a decl from the middle of a list, assuming the+-- list has already been split into a (possibly empty) front before the decl,+-- and a back where the head is the decl to be removed.+doRmDecl :: [GHC.LHsDecl GHC.RdrName] -> [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+doRmDecl decls1 decls2+  = do+      let decls2'      = gtail "doRmDecl 1" decls2+          declToRemove = head decls2++      -- logDataWithAnns "doRmDecl:(decls1,decls2)" (decls1,decls2)+      unless (null decls1)  $ do liftT $ balanceComments (last decls1) declToRemove+      unless (null decls2') $ do liftT $ balanceComments declToRemove  (head decls2')++      when (not (null decls2') && null decls1) $ do liftT $ transferEntryDPT declToRemove (head decls2')+      when (not (null decls2') && not (null decls1) && not (isTypeSigDecl (last decls1)))+        $ do liftT $ transferEntryDPT declToRemove (head decls2')++      -- logDataWithAnns "doRmDecl:(decls2')" (decls2')+      return $ (decls1 ++ decls2')++-- ---------------------------------------------------------------------++-- | Remove multiple type signatures+rmTypeSigs :: (SYB.Data t) =>+         [GHC.Name]  -- ^ The identifiers whose type signatures are to be removed.+      -> t           -- ^ The declarations+      -> RefactGhc (t,[GHC.LSig GHC.RdrName])+                     -- ^ The result and removed signatures, if there+                     -- were any+rmTypeSigs pns t = do+  (t',demotedSigsMaybe) <- foldM (\(tee,ds) n -> do { (tee',d) <- rmTypeSig n tee; return (tee', ds++[d])}) (t,[]) pns+  return (t',catMaybes demotedSigsMaybe)++-- ---------------------------------------------------------------------++-- | Remove the type signature that defines the given identifier's+-- type from the declaration list.+rmTypeSig :: (SYB.Data t) =>+         GHC.Name    -- ^ The identifier whose type signature is to be removed.+      -> t           -- ^ The declarations+      -> RefactGhc (t,Maybe (GHC.LSig GHC.RdrName))+                     -- ^ The result and removed signature, if there+                     -- was one++                     -- NOTE: It may have originated from a SigD, it is up+                     -- to the calling function to insert this if required+rmTypeSig pn t+  = do+     setStateStorage StorageNone+     t' <- SYB.everywhereMStaged SYB.Renamer (SYB.mkM inMatch `SYB.extM` inPatDecl `SYB.extM` inModule) t+     storage <- getStateStorage+     let sig' = case storage of+                  StorageSigRdr sig -> Just sig+                  StorageNone       -> Nothing+                  x -> error $ "rmTypeSig: unexpected value in StateStorage:" ++ (show x)+     return (t',sig')+  where+   inModule :: GHC.ParsedSource -> RefactGhc GHC.ParsedSource+   inModule (modu :: GHC.ParsedSource)+      = doRmTypeSig modu++   -- Deals with the distrinct parts of a FunBind+   inMatch :: GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)+           -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+   inMatch x@(GHC.L _ (GHC.Match _ _ _ (GHC.GRHSs _ _localDecls)))+      = doRmTypeSig x++   inPatDecl ::GHC.LHsDecl GHC.RdrName -> RefactGhc (GHC.LHsDecl GHC.RdrName)+   inPatDecl x@(GHC.L _ (GHC.ValD (GHC.PatBind _ _ _ _ _))) = do+      decls <- liftT $ hsDeclsPatBindD x+      decls' <- doRmTypeSigDecls decls+      liftT $ replaceDeclsPatBindD x decls'++   inPatDecl x = return x++   -- ----------------------------------++   doRmTypeSig :: (HasDecls t) => t -> RefactGhc t+   doRmTypeSig parent = do+     decls <- liftT $ hsDecls parent+     decls' <- doRmTypeSigDecls decls+     liftT $ replaceDecls parent decls'+++   doRmTypeSigDecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc [GHC.LHsDecl GHC.RdrName]+   doRmTypeSigDecls decls = do+     isDone <- getDone+     if isDone+       then return decls+       else do+         -- logDataWithAnns "doRmTypeSig:decls" decls+         nameMap <- getRefactNameMap+         let (decls1,decls2)= break (definesSigDRdr nameMap pn) decls+         if not $ null decls2+            then do+              -- logDataWithAnns "doRmTypeSig:parent" parent+#if __GLASGOW_HASKELL__ <= 710+              let sig@(GHC.L sspan (GHC.SigD (GHC.TypeSig names typ p))) = ghead "rmTypeSig" decls2+#else+              let sig@(GHC.L sspan (GHC.SigD (GHC.TypeSig names typ))) = ghead "rmTypeSig" decls2+#endif+              if length names > 1+                  then do+                      let newNames = filter (\rn -> rdrName2NamePure nameMap rn /= pn) names+#if __GLASGOW_HASKELL__ <= 710+                          newSig = GHC.L sspan (GHC.SigD (GHC.TypeSig newNames typ p))+#else+                          newSig = GHC.L sspan (GHC.SigD (GHC.TypeSig newNames typ))+#endif++                      liftT $ removeTrailingCommaT (glast "doRmTypeSig" newNames)++                      let pnt = ghead "rmTypeSig" (filter (\rn -> rdrName2NamePure nameMap rn == pn) names)+                      liftT $ removeTrailingCommaT pnt++                      -- Construct the old signature, by keeping the+                      -- signature part but discarding the other names+                      newSpan <- liftT uniqueSrcSpanT+#if __GLASGOW_HASKELL__ <= 710+                      let oldSig = (GHC.L newSpan (GHC.TypeSig [pnt] typ p))+#else+                      let oldSig = (GHC.L newSpan (GHC.TypeSig [pnt] typ))+#endif+                      liftT $ modifyAnnsT (copyAnn sig oldSig)+                      setStateStorage (StorageSigRdr oldSig)++                      return (decls1++[newSig]++gtail "doRmTypeSig" decls2)+                  else do+                      let [oldSig] = decl2Sig sig+                      setStateStorage (StorageSigRdr oldSig)+                      decls' <- doRmDecl decls1 decls2+                      return decls'+            else do+              return decls++   getDone = do+     s <- getStateStorage+     case s of+       StorageNone -> return False+       _           -> return True++-- ---------------------------------------------------------------------++-- TODO: Is this function needed with GHC?++-- | Remove the qualifier from the given identifiers in the given syntax phrase.+rmQualifier:: (SYB.Data t)+             =>[GHC.Name]       -- ^ The identifiers.+               ->t           -- ^ The syntax phrase.+               ->RefactGhc t -- ^ The result.+rmQualifier pns t = do+  nm <- getRefactNameMap+  SYB.everywhereM (nameSybTransform (rename nm)) t+    where+     rename nm (ln@(GHC.L l pn)::GHC.Located GHC.RdrName)+       | elem (rdrName2NamePure nm ln) pns+       = do+              case pn of+                GHC.Qual _ n -> return (GHC.L l (GHC.Unqual n))+                _            -> return ln+     rename _ x = return  x++-- ---------------------------------------------------------------------++-- | Replace all occurences of a top level GHC.Name with a qualified version.+qualifyToplevelName :: GHC.Name -> RefactGhc ()+qualifyToplevelName n = do+    parsed <- getRefactParsed+    parsed' <- renamePN n n Qualify parsed+    putRefactParsed parsed' emptyAnns+    return ()++-- ---------------------------------------------------------------------++data HowToQual = Qualify | NoQualify | PreserveQualify+               deriving (Show,Eq)++instance GHC.Outputable HowToQual where+  ppr x = GHC.text (show x)++-- | Rename each occurrences of the identifier in the given syntax+-- phrase with the new name.++-- TODO: the syntax phrase is required to be GHC.Located, not sure how+-- to specify this without breaking the everywhereMStaged call++renamePN::(SYB.Data t)+   => GHC.Name            -- ^ The identifier to be renamed.+   -> GHC.Name            -- ^ The new name, including possible qualifier+   -> HowToQual+                          --   the new name.+   -> t                   -- ^ The syntax phrase+   -> RefactGhc t+renamePN oldPN newName useQual t = do+  -- logm $ "renamePN: (oldPN,newName)=" ++ (showGhc (oldPN,newName))+  -- logm $ "renamePN: t=" ++ (SYB.showData SYB.Parser 0 t)+  -- nm <- getRefactNameMap+  newNameQual   <- rdrNameFromName True  newName+  newNameUnqual <- rdrNameFromName False newName+  -- newNameRdr    <- rdrNameFromName useQual newName+  -- logm $ "renamePN: (newNameQual,newNameUnqual,newNameRdr)=" ++ showGhc (newNameQual,newNameUnqual,newNameRdr)++  let+    cond :: NameMap -> GHC.Located GHC.RdrName -> Bool+    cond nm (GHC.L ln _) =+      case Map.lookup ln nm of+        Nothing -> False+        Just n -> GHC.nameUnique n == GHC.nameUnique oldPN || GHC.nameUnique n == GHC.nameUnique newName++    -- Decision process for new names+    newNameCalc :: HowToQual -> GHC.RdrName -> GHC.RdrName+    newNameCalc uq old = newNameCalc' uq (GHC.isQual_maybe old)+      where+        newNameCalc' :: HowToQual -> (Maybe (GHC.ModuleName,GHC.OccName)) -> GHC.RdrName+        newNameCalc' Qualify         (Just (mn,_)) = GHC.Qual mn (GHC.occName newName)+        newNameCalc' PreserveQualify (Just (mn,_)) = GHC.Qual mn (GHC.occName newName)+        newNameCalc' NoQualify       (Just (_n,_)) = GHC.Unqual  (GHC.occName newName)+        newNameCalc' uq' _ =  if uq' == Qualify then newNameQual else newNameUnqual++    -- ---------------------------------++    makeNewName :: GHC.Located GHC.RdrName -> GHC.RdrName -> RefactGhc (GHC.Located GHC.RdrName)+    makeNewName old newRdr = do+      ss' <- liftT $ uniqueSrcSpanT+      let new = (GHC.L ss' newRdr)+      liftT $ modifyAnnsT (copyAnn old new)+      addToNameMap ss' newName+      return new++    -- ---------------------------------++    renameLRdr :: HowToQual -> GHC.Located GHC.RdrName -> RefactGhc (GHC.Located GHC.RdrName)+    renameLRdr useQual' old@(GHC.L _ n) = do+     nm <- getRefactNameMap+     if cond nm old+       then do+          logDataWithAnns "renamePN:rename old :" old+          -- let nn = newNameCalcBool useQual' n+          let nn = newNameCalc useQual' n+          new <- makeNewName old nn+          logDataWithAnns "renamePN:rename new :" new+          logDataWithAnns "renamePN:rename old2 :" old+          return new+       else return old++    -- ---------------------------------++    renameVar :: HowToQual -> GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+    renameVar useQual' x@(GHC.L l (GHC.HsVar n)) = do+#else+    renameVar useQual' x@(GHC.L l (GHC.HsVar (GHC.L _ n))) = do+#endif+     nm <- getRefactNameMap+     if cond nm (GHC.L l n)+       then do+          let nn = newNameCalc useQual' n+#if __GLASGOW_HASKELL__ <= 710+          ss' <- liftT $ uniqueSrcSpanT+          let (GHC.L l' _) = (GHC.L ss' nn)+          liftT $ modifyAnnsT (copyAnn x (GHC.L ss' (GHC.HsVar nn)))+          addToNameMap ss' newName+          return (GHC.L l' (GHC.HsVar nn))+#else+          new <- makeNewName (GHC.L l n) nn+          return (GHC.L l (GHC.HsVar new))+#endif+       else return x+    renameVar _ x = return x++    -- ---------------------------------++    renameTyVar :: HowToQual -> (GHC.Located (GHC.HsType GHC.RdrName)) -> RefactGhc (GHC.Located (GHC.HsType GHC.RdrName))+#if __GLASGOW_HASKELL__ <= 710+    renameTyVar useQual' x@(GHC.L l (GHC.HsTyVar n)) = do+#else+    renameTyVar useQual' x@(GHC.L l (GHC.HsTyVar (GHC.L _ n))) = do+#endif+     nm <- getRefactNameMap+     if cond nm (GHC.L l n)+       then do+          logm $ "renamePN:renameTyVar at :" ++ (showGhc l)+          let nn = newNameCalc useQual' n+#if __GLASGOW_HASKELL__ <= 710+          ss' <- liftT $ uniqueSrcSpanT+          let (GHC.L l' _) = (GHC.L ss' nn)+          liftT $ modifyAnnsT (copyAnn x (GHC.L ss' (GHC.HsTyVar nn)))+          addToNameMap ss' newName+          return (GHC.L l' (GHC.HsTyVar nn))+#else+          new <- makeNewName (GHC.L l n) nn+          return (GHC.L l (GHC.HsTyVar new))+#endif+       else return x+    renameTyVar _ x = return x++    -- ---------------------------------++    renameHsTyVarBndr :: HowToQual -> GHC.LHsTyVarBndr GHC.RdrName -> RefactGhc (GHC.LHsTyVarBndr GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+    renameHsTyVarBndr useQual' x@(GHC.L l (GHC.UserTyVar n)) = do+#else+    renameHsTyVarBndr useQual' x@(GHC.L l (GHC.UserTyVar (GHC.L _ n))) = do+#endif+     nm <- getRefactNameMap+     if cond nm (GHC.L l n)+       then do+          logm $ "renamePN:renameHsTyVarBndr at :" ++ (showGhc l)+          -- let nn = newNameCalcBool useQual' n+          let nn = newNameCalc useQual' n+#if __GLASGOW_HASKELL__ <= 710+          addToNameMap l newName+          return (GHC.L l (GHC.UserTyVar nn))+#else+          new <- makeNewName (GHC.L l n) nn+          return (GHC.L l (GHC.UserTyVar new))+#endif+       else return x+    renameHsTyVarBndr _ x = return x++    -- ---------------------------------++    renameLIE :: HowToQual -> (GHC.LIE GHC.RdrName) -> RefactGhc (GHC.LIE GHC.RdrName)+    renameLIE useQual' x@(GHC.L l (GHC.IEVar old@(GHC.L ln n))) = do+     nm <- getRefactNameMap+     if cond nm (GHC.L ln n)+       then do+          -- logm $ "renamePN:renameLIE.IEVar at :" ++ (showGhc l)+          let nn = newNameCalc useQual' n++          new <- makeNewName old nn++          return (GHC.L l (GHC.IEVar new))+       else return x++    renameLIE useQual' x@(GHC.L l (GHC.IEThingAbs old@(GHC.L _ln n))) = do+     nm <- getRefactNameMap+     if cond nm (GHC.L l n)+       then do+          -- logm $ "renamePN:renameLIE.IEThingAbs at :" ++ (showGhc l)+          let nn = newNameCalc useQual' n++          new <- makeNewName old nn++          return (GHC.L l (GHC.IEThingAbs new))+       else return x++    renameLIE useQual' x@(GHC.L l (GHC.IEThingAll old@(GHC.L ln n))) = do+     nm <- getRefactNameMap+     if cond nm (GHC.L ln n)+       then do+          -- logm $ "renamePN:renameLIE.IEThingAll at :" ++ (showGhc l)+          let nn = newNameCalc useQual' n++          new <- makeNewName old nn++          return (GHC.L l (GHC.IEThingAll new))+       else return x++    -- TODO: check inside the ns here too+#if __GLASGOW_HASKELL__ <= 710+    renameLIE useQual' (GHC.L l (GHC.IEThingWith old@(GHC.L ln n) ns))+#else+    renameLIE useQual' (GHC.L l (GHC.IEThingWith old@(GHC.L ln n) wc ns fls))+#endif+     = do+         nm <- getRefactNameMap+         old' <- if (cond nm (GHC.L ln n))+           then do+             logm $ "renamePN:renameLIE.IEThingWith at :" ++ (showGhc l)+             -- let nn = newNameCalcBool useQual' n+             let nn = newNameCalc useQual' n+             new <- makeNewName old nn+             return new+           else return old+++         ns' <- if (any (\(GHC.L lnn nn) -> cond nm (GHC.L lnn nn)) ns)+           then renameTransform useQual' ns+           else return ns+#if __GLASGOW_HASKELL__ <= 710+         return (GHC.L l (GHC.IEThingWith old' ns'))+#else+         return (GHC.L l (GHC.IEThingWith old' wc ns' fls))+#endif++    renameLIE _ x = do+         -- logm $ "renamePN:renameLIE miss for :" ++ (showGhc x)+         return x++    -- ---------------------------------++    renameLPat :: HowToQual -> (GHC.LPat GHC.RdrName) -> RefactGhc (GHC.LPat GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+    renameLPat useQual' x@(GHC.L l (GHC.VarPat n)) = do+#else+    renameLPat useQual' x@(GHC.L l (GHC.VarPat (GHC.L _ n))) = do+#endif+     nm <- getRefactNameMap+     if cond nm (GHC.L l n)+       then do+          logm $ "renamePNworker:renameLPat at :" ++ (showGhc l)+          let nn = newNameCalc useQual' n+#if __GLASGOW_HASKELL__ <= 710+          ss' <- liftT $ uniqueSrcSpanT+          let (GHC.L l' _) = (GHC.L ss' nn)+          liftT $ modifyAnnsT (copyAnn x (GHC.L ss' (GHC.VarPat nn)))+          addToNameMap ss' newName+          return (GHC.L l' (GHC.VarPat nn))+#else+          new <- makeNewName (GHC.L l n) nn+          return (GHC.L l (GHC.VarPat new))+#endif+       else return x+    renameLPat _ x = return x++    -- ---------------------------------++    renameMatch :: HowToQual -> GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)+                -> RefactGhc (GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))+    renameMatch _useQual (GHC.Match mln pats ty grhss) = do+     logm $ "renamePN.renameMatch entered:"+     pats'  <- renameTransform _useQual pats+     ty'    <- renameTransform _useQual ty+     grhss' <- renameTransform _useQual grhss+     mln' <- case mln of+#if __GLASGOW_HASKELL__ <= 710+       Just (old@(GHC.L lmn mn),f) -> do+         nm <- getRefactNameMap+         if cond nm (GHC.L lmn mn)+           then do+             new <- makeNewName old newNameUnqual+             return (Just (new,f))+           else return mln+       Nothing -> return mln+#else+       GHC.FunBindMatch old f -> do+         nm <- getRefactNameMap+         if cond nm old+           then do+             new <- makeNewName old newNameUnqual+             return (GHC.FunBindMatch new f)+           else return mln+       GHC.NonFunBindMatch -> return mln+#endif+     return (GHC.Match mln' pats' ty' grhss')++    -- ---------------------------------++    renameImportDecl :: HowToQual -> GHC.ImportDecl GHC.RdrName -> RefactGhc (GHC.ImportDecl GHC.RdrName)+    renameImportDecl _useQual (GHC.ImportDecl src mn mq isrc isafe iq ii ma (Just (ij,GHC.L ll ies))) = do+      ies' <- mapM (renameLIE PreserveQualify) ies+      logm $ "renamePN'.renameImportDecl:(ies,ies')=" ++ showGhc (ies,ies')+      return (GHC.ImportDecl src mn mq isrc isafe iq ii ma (Just (ij,GHC.L ll ies')))+    renameImportDecl _ x = return x++    -- ---------------------------------++    renameTypeSig :: HowToQual -> (GHC.Sig GHC.RdrName) -> RefactGhc (GHC.Sig GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+    renameTypeSig _useQual (GHC.TypeSig ns typ p)+#else+    renameTypeSig _useQual (GHC.TypeSig ns typ)+#endif+     = do+         logm $ "renamePN:renameTypeSig"+         ns'  <- mapM (renameLRdr NoQualify) ns+         typ' <- renameTransform _useQual typ+         logm $ "renamePN:renameTypeSig done"+#if __GLASGOW_HASKELL__ <= 710+         return (GHC.TypeSig ns' typ' p)+#else+         return (GHC.TypeSig ns' typ')+#endif+#if __GLASGOW_HASKELL__ > 710+    renameTypeSig _useQual (GHC.ClassOpSig f ns typ)+     = do+         ns'  <- mapM (renameLRdr NoQualify) ns+         typ' <- renameTransform _useQual typ+         return (GHC.ClassOpSig f ns' typ')+#endif+    renameTypeSig _ x = return x++    -- ---------------------------------++    everywhereMSkip :: Monad m => SYB.GenericM m -> SYB.GenericM m+    everywhereMSkip f x+      | (const False `SYB.extQ` typeSig)    x = f x  -- no recursion for typeSig+      | (const False `SYB.extQ` match)      x = f x  -- no recursion for FunBind+      | (const False `SYB.extQ` importDecl) x = f x  -- no recursion for ImportDecl+      | otherwise = do x' <- f x+                       SYB.gmapM (everywhereMSkip f) x'+      where+        typeSig    = const True :: GHC.Sig GHC.RdrName -> Bool+        match      = const True :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Bool+        importDecl = const True :: GHC.ImportDecl GHC.RdrName -> Bool++    renameTransform useQual' t' =+            (everywhereMSkip ( -- top-down, skipping Located Names for Sig/Match+                   SYB.mkM   (renameVar         useQual')+                  `SYB.extM` (renameLRdr        useQual')+                  `SYB.extM` (renameTyVar       useQual')+                  `SYB.extM` (renameHsTyVarBndr useQual')+                  `SYB.extM` (renameLIE         useQual')+                  `SYB.extM` (renameLPat        useQual')+                  `SYB.extM` (renameTypeSig     useQual')+                  `SYB.extM` (renameImportDecl  useQual')+                  `SYB.extM` (renameMatch       useQual')+                   ) t')+  t' <- renameTransform useQual t+  return t'++-- ---------------------------------------------------------------------++-- | Check whether the specified identifier is declared in the given syntax phrase t,+-- if so, rename the identifier by creating a new name automatically.+autoRenameLocalVar:: (SYB.Data t)+                     => GHC.Name    -- ^ The identifier.+                     -> t           -- ^ The syntax phrase.+                     -> RefactGhc t -- ^ The result.+autoRenameLocalVar pn t = do+  logm $ "autoRenameLocalVar: (pn)=" ++ (showGhc (pn))+  -- = everywhereMStaged SYB.Renamer (SYB.mkM renameInMatch)+  nm <- getRefactNameMap+  decls <- liftT $ hsDeclsGeneric t+  if isDeclaredInRdr nm pn decls+         then do t' <- worker t+                 return t'+         else do return t++      where+         worker :: (SYB.Data t) => t -> RefactGhc t+         worker tt+                   =do (f,d) <- hsFDNamesFromInsideRdr tt+                       ds <- hsVisibleNamesRdr pn tt+                       let newNameStr = mkNewName (nameToString pn) (nub (f `union` d `union` ds)) 1+                       newName <- mkNewGhcName Nothing newNameStr+                       renamePN pn newName PreserveQualify tt++-- ---------------------------------------------------------------------++isMainModule :: GHC.Module -> Bool+#if __GLASGOW_HASKELL__ <= 710+isMainModule modu = GHC.modulePackageKey modu == GHC.mainPackageKey+#else+isMainModule modu = GHC.moduleUnitId modu == GHC.mainUnitId+#endif++-- ---------------------------------------------------------------------++-- | Return the identifier's defining location.+-- defineLoc::PNT->SrcLoc+defineLoc :: GHC.Located GHC.Name -> GHC.SrcLoc+defineLoc (GHC.L _ name) = GHC.nameSrcLoc name++-- | Return the identifier's source location.+-- useLoc::PNT->SrcLoc+useLoc:: (GHC.Located GHC.Name) -> GHC.SrcLoc+-- useLoc (GHC.L l _) = getGhcLoc l+useLoc (GHC.L l _) = GHC.srcSpanStart l++-- ---------------------------------------------------------------------++-- | Return the type checked `GHC.Id` corresponding to the given+-- `GHC.Name`++-- TODO: there has to be a simpler way, using the appropriate GHC internals+findIdForName :: GHC.Name -> RefactGhc (Maybe GHC.Id)+findIdForName n = do+  tm <- getTypecheckedModule+  let t = GHC.tm_typechecked_source tm+  let r = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` worker) t+      worker (i::GHC.Id)+         | (GHC.nameUnique n) ==  (GHC.varUnique i) = Just i+      worker _ = Nothing+  return r++-- ---------------------------------------------------------------------++getTypeForName :: GHC.Name -> RefactGhc (Maybe GHC.Type)+getTypeForName n = do+  mId <-  findIdForName n+  case mId of+    Nothing -> return Nothing+    Just i -> return $ Just (GHC.varType i)++-- ---------------------------------------------------------------------++-- | Given the syntax phrase, find the largest-leftmost expression+-- contained in the region specified by the start and end position, if+-- found.+locToExp:: (SYB.Data t,SYB.Typeable n) =>+                   SimpPos    -- ^ The start position.+                -> SimpPos    -- ^ The end position.+                -> t          -- ^ The syntax phrase.+                -> Maybe (GHC.LHsExpr n) -- ^ The result.+locToExp beginPos endPos t = res+  where+     res = SYB.somethingStaged SYB.Parser Nothing (Nothing `SYB.mkQ` expr) t++     expr :: GHC.LHsExpr n -> Maybe (GHC.LHsExpr n)+     expr e+        |inScope e = Just e+     expr _ = Nothing++     inScope :: GHC.Located e -> Bool+     inScope (GHC.L l _) =+       let+         (startLoc,endLoc) = case l of+           (GHC.RealSrcSpan ss) ->+             ((GHC.srcSpanStartLine ss,GHC.srcSpanStartCol ss),+              (GHC.srcSpanEndLine ss,GHC.srcSpanEndCol ss))+           (GHC.UnhelpfulSpan _) -> ((0,0),(0,0))+       in+        (startLoc>=beginPos) && (startLoc<= endPos) && (endLoc>= beginPos) && (endLoc<=endPos)++--------------------------------------------------------------------------------++-- | If an expression consists of only one identifier then return this+-- identifier in the GHC.Name format, otherwise return the default Name+expToNameRdr :: NameMap -> GHC.LHsExpr GHC.RdrName -> Maybe GHC.Name+#if __GLASGOW_HASKELL__ <= 710+expToNameRdr nm (GHC.L l (GHC.HsVar pnt)) = Just (rdrName2NamePure nm (GHC.L l pnt))+#else+expToNameRdr nm (GHC.L _ (GHC.HsVar pnt)) = Just (rdrName2NamePure nm pnt)+#endif+expToNameRdr nm (GHC.L _ (GHC.HsPar e))   = expToNameRdr nm e+expToNameRdr _ _ = Nothing++nameToString :: GHC.Name -> String+-- nameToString name = showGhc name+nameToString name = showGhcQual name++-- | If a pattern consists of only one identifier then return this+-- identifier, otherwise return Nothing+patToNameRdr :: NameMap -> GHC.LPat GHC.RdrName -> Maybe GHC.Name+#if __GLASGOW_HASKELL__ <= 710+patToNameRdr nm (GHC.L l (GHC.VarPat n)) = Just (rdrName2NamePure nm (GHC.L l n))+#else+patToNameRdr nm (GHC.L _ (GHC.VarPat n)) = Just (rdrName2NamePure nm n)+#endif+patToNameRdr _ _ = Nothing++-- | Compose a pattern from a pName.+{-# DEPRECATED pNtoPat "Can't use Renamed in GHC 8" #-}+pNtoPat :: name -> GHC.Pat name+#if __GLASGOW_HASKELL__ <= 710+pNtoPat pname = GHC.VarPat pname+#else+pNtoPat pname = GHC.VarPat (GHC.noLoc pname)+#endif  -- EOF

src/Language/Haskell/Refact/Utils/Types.hs view

@@ -1,8 +1,9 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE FlexibleInstances    #-} module Language.Haskell.Refact.Utils.Types        (         ApplyRefacResult        , RefacResult(..)-       , RefacSource(..)        -- *        , TreeId(..)        , mainTid@@ -13,9 +14,12 @@         ) where -import qualified GHC      as GHC+import qualified GHC        as GHC+-- import qualified Name       as GHC+-- import qualified Outputable as GHC  import Language.Haskell.GHC.ExactPrint+-- import Language.Haskell.GHC.ExactPrint.Utils  import qualified Data.Map as Map @@ -28,11 +32,6 @@ data RefacResult = RefacModified | RefacUnmodifed                  deriving (Show,Ord,Eq) --data RefacSource = RSFile FilePath-                 | RSMod GHC.ModSummary-                 | RSAlreadyLoaded- -- ---------------------------------------------------------------------  data TreeId = TId !Int deriving (Eq,Ord,Show)@@ -54,3 +53,7 @@  type NameMap = Map.Map GHC.SrcSpan GHC.Name +-- instance GHC.Outputable NameMap where+--   ppr nm = GHC.text "NameMap" GHC.<+> GHC.hcat (map one $ Map.toList nm)+--     where+--       one (s,n) = GHC.text (showGhc (s,n,GHC.nameUnique n))

src/Language/Haskell/Refact/Utils/Utils.hs view

@@ -28,14 +28,16 @@        , modifiedFiles        , writeRefactoredFiles +       , stripCallStack+        ) where -import Control.Exception+-- import Control.Exception import Control.Monad.Identity import Control.Monad.State import Data.List -import Language.Haskell.GHC.ExactPrint+-- import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Preprocess import Language.Haskell.GHC.ExactPrint.Print import Language.Haskell.GHC.ExactPrint.Types@@ -103,7 +105,6 @@  setDynFlags :: GHC.DynFlags -> GHC.Ghc GHC.DynFlags setDynFlags df = return (GHC.gopt_set df GHC.Opt_KeepRawTokenStream)--- setDynFlags df = return df  -- --------------------------------------------------------------------- @@ -208,15 +209,6 @@  -- --------------------------------------------------------------------- -cdAndDo :: FilePath -> IO a -> IO a-cdAndDo path fn = do-  old <- getCurrentDirectory-  r <- GHC.gbracket (setCurrentDirectory path) (\_ -> setCurrentDirectory old)-          $ const fn-  return r---- ---------------------------------------------------------------------- canonicalizeTargets :: Targets-> IO Targets canonicalizeTargets tgts = do   cur <- getCurrentDirectory@@ -245,6 +237,8 @@     fileName <- case source of          RSFile fname    -> do parseSourceFileGhc fname                                return fname+         RSTarget tgt    -> do getTargetGhc tgt+                               return (GM.mpPath tgt)          RSMod  ms       -> do parseSourceFileGhc $ fileNameFromModSummary ms                                return $ fileNameFromModSummary ms          RSAlreadyLoaded -> do mfn <- getRefactFileName@@ -451,3 +445,15 @@                  $ map summaryNodeSummary $ GHC.reachableG mg modNode    return serverMods++-- ---------------------------------------------------------------------++-- | In GHC 8 an error has an attached callstack. This is not always what we+-- want, so this function strips it+stripCallStack :: String -> String+stripCallStack str = str'+  where+    s1 = init $ unlines $ takeWhile (\s -> s /= "CallStack (from HasCallStack):") $ lines str+    str' = if last str == '\n'+              then s1 ++ "\n"+              else s1

src/Language/Haskell/Refact/Utils/Variables.hs view

@@ -17,2459 +17,1590 @@     isFieldName   , isClassName   , isInstanceName-  , isDeclaredIn,isDeclaredInRdr-  , FreeNames(..),DeclaredNames(..)-  , hsFreeAndDeclaredPNsOld-  , hsFreeAndDeclaredRdr-  , hsFreeAndDeclaredNameStrings-  , hsFreeAndDeclaredPNs-  , hsFreeAndDeclaredGhc-  , getDeclaredTypes-  , getDeclaredTypesRdr-  , getFvs, getFreeVars, getDeclaredVars-  , hsVisiblePNs, hsVisiblePNsRdr, hsVisibleNames, hsVisibleNamesRdr-  , hsFDsFromInsideRdr, hsFDNamesFromInsideRdr-  , hsFDsFromInside, hsFDNamesFromInside-  , hsVisibleDs, hsVisibleDsRdr-  , rdrName2Name, rdrName2NamePure-  , eqRdrNamePure-  , rdrName2Name'--  -- ** Identifiers, expressions, patterns and declarations-  , FindEntity(..)-  , sameOccurrence-  , definedPNs, definedPNsRdr,definedNamesRdr-  , definingDeclsRdrNames,definingDeclsRdrNames',definingSigsRdrNames-  , definingDeclsNames, definingDeclsNames', definingSigsNames-  , definingTyClDeclsNames-  , defines-  , definesRdr,definesDeclRdr-  , definesTypeSig,definesTypeSigRdr,definesSigDRdr-  , definesP-  , allNames--  , hsPNs, hsNamess, hsNamessRdr-  , locToName, locToRdrName-  ) where--import Control.Monad.State-import Data.List-import Data.Maybe-import Data.Monoid--import Language.Haskell.Refact.Utils.Binds-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.Types--import Language.Haskell.GHC.ExactPrint.Types-import Language.Haskell.GHC.ExactPrint-import Language.Haskell.GHC.ExactPrint.Utils----- Modules from GHC-import qualified Bag           as GHC-import qualified GHC           as GHC-import qualified Name          as GHC-import qualified NameSet       as GHC-import qualified Outputable    as GHC-import qualified RdrName       as GHC-import qualified UniqSet       as GHC--import qualified Data.Generics as SYB-import qualified GHC.SYB.Utils as SYB--import qualified Data.Map as Map--import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero)---- -----------------------------------------------------------------------class (SYB.Data a, SYB.Typeable a) => FindEntity a where--  -- | Returns True is a syntax phrase, say a, is part of another-  -- syntax phrase, say b.-  -- NOTE: very important: only do a shallow check-  findEntity:: (SYB.Data b) => a -> b -> Bool---- -----------------------------------------------------------------------instance FindEntity GHC.Name where--  findEntity n t = fromMaybe False res-   where-    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t--    worker (name::GHC.Name)-      | n == name = Just True-    worker _ = Nothing----- This instance does not make sense, it will only find the specific RdrName--- where it was found, not any other instances of it.-instance FindEntity (GHC.Located GHC.RdrName) where--  findEntity ln t =-    case SYB.something (nameSybQuery checkRdr) t of-      Nothing -> False-      _       -> True-    where-      checkRdr :: GHC.Located GHC.RdrName -> Maybe Bool-      checkRdr n-        | sameOccurrence n ln = Just True-        | otherwise = Nothing---- ----------------------------------------------------------------------{---- This is not precise enough, RdrNames are ambiguous-instance FindEntity GHC.RdrName where--  findEntity n t = fromMaybe False res-   where-    res = SYB.something (Nothing `SYB.mkQ` worker) t--    worker (name::GHC.RdrName)-      | n == name = Just True-    worker _ = Nothing--}--- ------------------------------------------------------------------------- TODO: should the location be matched too in this case?-instance FindEntity (GHC.Located GHC.Name) where--  findEntity n t = fromMaybe False res-   where-    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t--    worker (name::GHC.Located GHC.Name)-      | n == name = Just True-    worker _ = Nothing----- -----------------------------------------------------------------------instance FindEntity (GHC.LHsExpr GHC.RdrName) where--  findEntity e t = fromMaybe False res-   where-    res = SYB.something (Nothing `SYB.mkQ` worker) t--    worker (expr :: GHC.LHsExpr GHC.RdrName)-      | sameOccurrence e expr = Just True-    worker _ = Nothing---- TODO: remove this instance-instance FindEntity (GHC.LHsExpr GHC.Name) where--  findEntity e t = fromMaybe False res-   where-    res = SYB.something (Nothing `SYB.mkQ` worker) t--    worker (expr :: GHC.LHsExpr GHC.Name)-      | sameOccurrence e expr = Just True-    worker _ = Nothing---- -----------------------------------------------------------------------instance FindEntity (GHC.Located (GHC.HsBindLR GHC.Name GHC.Name)) where-  findEntity e t = fromMaybe False res-   where-    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t--    worker (expr::(GHC.Located (GHC.HsBindLR GHC.Name GHC.Name)))-      | sameOccurrence e expr = Just True-    worker _ = Nothing--instance FindEntity (GHC.Located (GHC.HsDecl GHC.Name)) where-  findEntity d t = fromMaybe False res-   where-    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t--    worker (decl::(GHC.Located (GHC.HsDecl GHC.Name)))-      | sameOccurrence d decl = Just True-    worker _ = Nothing---- ------------------------------------------------------------------------- TODO: AZ: pretty sure this can be simplified, depends if we need to---          manage transformed stuff too though.---- | Return True if syntax phrases t1 and t2 refer to the same one.-sameOccurrence :: (GHC.Located t) -> (GHC.Located t) -> Bool-sameOccurrence (GHC.L l1 _) (GHC.L l2 _)- = l1 == l2----- ------------------------------------------------------------------------- | For free variables-data FreeNames = FN { fn :: [GHC.Name] }---- | For declared variables-data DeclaredNames = DN { dn :: [GHC.Name] }--instance Show FreeNames where-  show (FN ls) = "FN " ++ showGhcQual ls--instance Show DeclaredNames where-  show (DN ls) = "DN " ++ showGhcQual ls--instance Monoid FreeNames where-  mempty = FN []-  mappend (FN a) (FN b) = FN (a `mappend` b)--instance Monoid DeclaredNames where-  mempty = DN []-  mappend (DN a) (DN b) = DN (a `mappend` b)---emptyFD :: (FreeNames,DeclaredNames)-emptyFD = (FN [], DN [])---- ------------------------------------------------------------------------ | True if the name is a field name-isFieldName :: GHC.Name -> Bool-isFieldName _n = error "undefined isFieldName"---- ------------------------------------------------------------------------ | True if the name is a field name-isClassName :: GHC.Name -> Bool-isClassName _n = error "undefined isClassName"---- ------------------------------------------------------------------------ | True if the name is a class instance-isInstanceName :: GHC.Name -> Bool-isInstanceName _n = error "undefined isInstanceName"----- ------------------------------------------------------------------------ | Collect the identifiers (in PName format) in a given syntax phrase.--hsPNs::(SYB.Data t)=> t -> [PName]-hsPNs t = (nub.ghead "hsPNs") res-  where-     res = SYB.everythingStaged SYB.Parser (++) [] ([] `SYB.mkQ` inPnt) t--     inPnt (pname :: GHC.RdrName) = return [(PN pname)]------------------------------------------------------------------------------------ ++AZ++ see if we can get away with one only..-isDeclaredIn :: (HsValBinds t GHC.Name) => GHC.Name -> t -> Bool-isDeclaredIn name t = nonEmptyList $ definingDeclsNames [name] (hsBinds t) False True--isDeclaredInRdr :: NameMap -> GHC.Name -> [GHC.LHsDecl GHC.RdrName] -> Bool-isDeclaredInRdr nm name decls = nonEmptyList $ definingDeclsRdrNames nm [name] decls False True---- ------------------------------------------------------------------------ | Collect the free and declared variables (in the GHC.Name format)--- in a given syntax phrase t. In the result, the first list contains--- the free variables, and the second list contains the declared--- variables.--- Expects RenamedSource-hsFreeAndDeclaredRdr :: (SYB.Data t) => NameMap -> t -> (FreeNames,DeclaredNames)-hsFreeAndDeclaredRdr nm t = res-  where-    fd = hsFreeAndDeclaredRdr' nm t-    (FN f,DN d) = fromMaybe mempty fd-    res = (FN (f \\ d),DN d)--hsFreeAndDeclaredRdr':: (SYB.Data t) => NameMap -> t -> Maybe (FreeNames,DeclaredNames)-hsFreeAndDeclaredRdr' nm t = do-      (FN f,DN d) <- hsFreeAndDeclared'-      let (f',d') = (nub f, nub d)-      return (FN f',DN d')-          -- hsFreeAndDeclared'=applyTU (stop_tdTU (failTU  `adhocTU` exp--   where-          hsFreeAndDeclared' :: Maybe (FreeNames,DeclaredNames)-          hsFreeAndDeclared' = applyTU (stop_tdTU (failTU-                                                      `adhocTU` expr-                                                      `adhocTU` pattern-                                                      `adhocTU` binds-                                                      `adhocTU` bindList-                                                      `adhocTU` match-                                                      `adhocTU` stmts-                                                      `adhocTU` rhs-                                                      `adhocTU` ltydecl-                                                       )) t--          -- expr ---          expr (GHC.L l (GHC.HsVar n))-            = return (FN [rdrName2NamePure nm (GHC.L l n)],DN [])--          expr (GHC.L _ (GHC.OpApp e1 (GHC.L l (GHC.HsVar n)) _ e2)) = do-              efed <- hsFreeAndDeclaredRdr' nm [e1,e2]-              fd   <- addFree (rdrName2NamePure nm (GHC.L l n)) efed-              return fd--          expr (GHC.L _ ((GHC.HsLam (GHC.MG matches _ _ _))) :: GHC.LHsExpr GHC.RdrName) =-             hsFreeAndDeclaredRdr' nm matches--          expr (GHC.L _ ((GHC.HsLet decls e)) :: GHC.LHsExpr GHC.RdrName) =-            do-              (FN df,DN dd) <- hsFreeAndDeclaredRdr' nm decls-              (FN ef,_)  <- hsFreeAndDeclaredRdr' nm e-              return (FN (df `union` (ef \\ dd)),DN [])--          expr (GHC.L _ (GHC.RecordCon ln _ e)) = do-            fd <- (hsFreeAndDeclaredRdr' nm e)-            addFree (rdrName2NamePure nm ln) fd   --Need Testing--          expr (GHC.L _ (GHC.EAsPat ln e)) = do-            fd <- (hsFreeAndDeclaredRdr' nm e)-            addFree (rdrName2NamePure nm ln) fd--          expr _ = mzero---          -- rhs ---          rhs ((GHC.GRHSs g ds) :: GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName))-            = do (FN df,DN dd) <- hsFreeAndDeclaredRdr' nm g-                 (FN ef,DN ed) <- hsFreeAndDeclaredRdr' nm ds-                 return (FN $ df ++ ef, DN $ dd ++ ed)---          -- pat ---          pattern (GHC.L _ (GHC.AsPat ln pat)) = do-            let (f,DN d) = fromMaybe mempty $ hsFreeAndDeclaredRdr' nm pat-            return (f,DN (rdrName2NamePure nm ln:d))--          pattern (GHC.L l (GHC.VarPat n))-            = return (FN [],DN [rdrName2NamePure nm (GHC.L l n)])-          -- It seems all the GHC pattern match syntax elements end up-          -- with GHC.VarPat--          pattern _ = mzero-          -- pattern _ = return ([],[])--          bindList (ds :: [GHC.LHsBind GHC.RdrName])-            =do (FN f,DN d) <- hsFreeAndDeclaredList ds-                return (FN (f\\d),DN d)-          -- bindList _ = mzero--          -- match and patBind, same type---          binds ((GHC.FunBind ln _ (GHC.MG matches _ _ _) _ _fvs _) :: GHC.HsBind GHC.RdrName)-            = do-                (FN pf,_pd) <- hsFreeAndDeclaredRdr' nm matches-                let n = rdrName2NamePure nm ln-                return (FN (pf \\ [n]) ,DN [n])--          -- patBind ---          binds (GHC.PatBind pat prhs _ _ds _) =-            do-              (FN pf,DN pd) <- hsFreeAndDeclaredRdr' nm pat-              (FN rf,DN rd) <- hsFreeAndDeclaredRdr' nm prhs-              return (FN $ pf `union` (rf \\ pd),DN $ pd ++ rd)--          binds _ = mzero--          match ((GHC.Match _fn pats _mtype mrhs) :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))-            = do-              (FN pf,DN pd) <- hsFreeAndDeclaredRdr' nm pats-              (FN rf,DN rd) <- hsFreeAndDeclaredRdr' nm mrhs-              return (FN (pf `union` (rf \\ (pd `union` rd))),DN [])--          -- stmts ---          stmts ((GHC.BindStmt pat expre _bindOp _failOp) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do-            -- TODO ++AZ++ : Not sure it is meaningful to pull-            --               anything out of bindOp/failOp-            (FN pf,DN pd)  <- hsFreeAndDeclaredRdr' nm pat-            (FN ef,_ed) <- hsFreeAndDeclaredRdr' nm expre-            let sf1 = []-            return (FN $ pf `union` ef `union` (sf1\\pd),DN []) -- pd) -- Check this--          stmts ((GHC.LetStmt binds') :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =-            hsFreeAndDeclaredRdr' nm binds'--          stmts _ = mzero--          -- tycldecls -------------------          ltydecl :: GHC.LTyClDecl GHC.RdrName -> Maybe (FreeNames,DeclaredNames)--          ltydecl (GHC.L _ (GHC.FamDecl fd)) = hsFreeAndDeclaredRdr' nm fd-          ltydecl (GHC.L _ (GHC.SynDecl ln _bndrs _rhs _fvs))-              = return (FN [],DN [rdrName2NamePure nm ln])-          ltydecl (GHC.L _ (GHC.DataDecl ln _bndrs defn _fvs)) = do-              let dds = map (rdrName2NamePure nm) $ concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn-              return (FN [],DN (rdrName2NamePure nm ln:dds))-          ltydecl (GHC.L _ (GHC.ClassDecl _ctx ln _tyvars-                           _fds _sigs meths ats atds _docs _fvs)) = do-             (_,md) <- hsFreeAndDeclaredRdr' nm meths-             (_,ad) <- hsFreeAndDeclaredRdr' nm ats-             (_,atd) <- hsFreeAndDeclaredRdr' nm atds-             return (FN [],DN [rdrName2NamePure nm ln] <> md <> ad <> atd)--          --------------------------------          addFree :: GHC.Name -> (FreeNames,DeclaredNames)-                  -> Maybe (FreeNames,DeclaredNames)-          addFree free (FN fr,de) = return (FN $ [free] `union` fr, de)--          hsFreeAndDeclaredList :: (SYB.Data t) => [t] -> Maybe (FreeNames,DeclaredNames)-          hsFreeAndDeclaredList l = do-            fds <- mapM (hsFreeAndDeclaredRdr' nm) l-            let-              unionF (FN a) (FN b) = FN (a `union` b)-              unionD (DN a) (DN b) = DN (a `union` b)-            return (foldr unionF mempty (map fst fds),-                    foldr unionD mempty (map snd fds))----- ------------------------------------------------------------------------ | Collect the free and declared variables (in the GHC.Name format)--- in a given syntax phrase t. In the result, the first list contains--- the free variables, and the second list contains the declared--- variables.--- Expects RenamedSource-hsFreeAndDeclaredPNsOld:: (SYB.Data t) => t -> ([GHC.Name],[GHC.Name])-hsFreeAndDeclaredPNsOld t = res-  where-    fd = hsFreeAndDeclaredPNs' t-    (f,d) = fromMaybe ([],[]) fd-    res = (f \\ d, d)--hsFreeAndDeclaredPNs':: (SYB.Data t) => t -> Maybe ([GHC.Name],[GHC.Name])-hsFreeAndDeclaredPNs' t = do-      (f,d) <- hsFreeAndDeclared'-      let (f',d') = (nub f, nub d)-      -- return (f' \\ d',d')-      return (f',d')-          -- hsFreeAndDeclared'=applyTU (stop_tdTU (failTU  `adhocTU` exp--   where--          hsFreeAndDeclared' = applyTU (stop_tdTU (failTU-                                                      `adhocTU` expr-                                                      `adhocTU` pattern-                                                      `adhocTU` binds-                                                      `adhocTU` bindList-                                                      `adhocTU` match-                                                      `adhocTU` stmts-                                                      `adhocTU` rhs-                                                       )) t--          -- expr ---          expr (GHC.HsVar n) = return ([n],[])--          expr (GHC.OpApp e1 (GHC.L _ (GHC.HsVar n)) _ e2) = do-              efed <- hsFreeAndDeclaredPNs' [e1,e2]-              fd   <- addFree n efed-              return fd--          expr ((GHC.HsLam (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.Name) =-             hsFreeAndDeclaredPNs' matches--          expr ((GHC.HsLet decls e) :: GHC.HsExpr GHC.Name) =-            do-              (df,dd) <- hsFreeAndDeclaredPNs' decls-              (ef,_)  <- hsFreeAndDeclaredPNs' e-              return ((df `union` (ef \\ dd)),[])--          expr (GHC.RecordCon (GHC.L _ n) _ e) = do-            fd <- (hsFreeAndDeclaredPNs' e)-            addFree n fd   --Need Testing--          expr (GHC.EAsPat (GHC.L _ n) e) = do-            fd <- (hsFreeAndDeclaredPNs' e)-            addFree n fd--          expr _ = mzero---          -- rhs ---          rhs ((GHC.GRHSs g ds) :: GHC.GRHSs GHC.Name (GHC.LHsExpr GHC.Name))-            = do (df,dd) <- hsFreeAndDeclaredPNs' g-                 (ef,ed) <- hsFreeAndDeclaredPNs' ds-                 return (df ++ ef, dd ++ ed)---          -- pat ---          pattern (GHC.AsPat (GHC.L _ n) pat) = do-            (f,d) <- hsFreeAndDeclaredPNs' pat-            return (f,n:d)--          pattern (GHC.VarPat n) = return ([],[n])-          -- It seems all the GHC pattern match syntax elements end up-          -- with GHC.VarPat--          pattern _ = mzero-          -- pattern _ = return ([],[])--          bindList (ds :: [GHC.LHsBind GHC.Name])-            =do (f,d) <- hsFreeAndDeclaredList ds-                return (f\\d,d)-          -- bindList _ = mzero--          -- match and patBind, same type---          binds ((GHC.FunBind (GHC.L _ n) _ (GHC.MG matches _ _ _) _ _fvs _) :: GHC.HsBind GHC.Name)-            = do-                (pf,_pd) <- hsFreeAndDeclaredPNs' matches--                return (pf \\ [n] ,[n])--          -- patBind ---          binds (GHC.PatBind pat prhs _ ds _) =-            do-              (pf,pd) <- hsFreeAndDeclaredPNs' pat-              (rf,rd) <- hsFreeAndDeclaredPNs' prhs-              return (pf `union` (rf \\pd),pd ++ GHC.uniqSetToList ds ++ rd)--          binds _ = mzero--          match ((GHC.Match _fn pats _mtype mrhs) :: GHC.Match GHC.Name (GHC.LHsExpr GHC.Name))-            = do-              (pf,pd) <- hsFreeAndDeclaredPNs' pats-              (rf,rd) <- hsFreeAndDeclaredPNs' mrhs-              return ((pf `union` (rf \\ (pd `union` rd))),[])--          -- stmts ---          stmts ((GHC.BindStmt pat expre _bindOp _failOp) :: GHC.Stmt GHC.Name (GHC.LHsExpr GHC.Name)) = do-            -- TODO ++AZ++ : Not sure it is meaningful to pull-            --               anything out of bindOp/failOp-            (pf,pd)  <- hsFreeAndDeclaredPNs' pat-            (ef,_ed) <- hsFreeAndDeclaredPNs' expre-            let sf1 = []-            return (pf `union` ef `union` (sf1\\pd),[]) -- pd) -- Check this--          stmts ((GHC.LetStmt binds') :: GHC.Stmt GHC.Name (GHC.LHsExpr GHC.Name)) =-            hsFreeAndDeclaredPNs' binds'--          stmts _ = mzero---          addFree :: GHC.Name -> ([GHC.Name],[GHC.Name])-                  -> Maybe ([GHC.Name],[GHC.Name])-          addFree free (fr,de) = return ([free] `union` fr, de)--          hsFreeAndDeclaredList l=do fds<-mapM hsFreeAndDeclaredPNs' l-                                     return (foldr union [] (map fst fds),-                                             foldr union [] (map snd fds))------ |The same as `hsFreeAndDeclaredPNs` except that the returned--- variables are in the String format.-hsFreeAndDeclaredNameStrings::(SYB.Data t,GHC.Outputable t)-  => t -> RefactGhc ([String],[String])-hsFreeAndDeclaredNameStrings t = do-  (f1,d1) <- hsFreeAndDeclaredPNs t-  return ((nub.map showGhc) f1, (nub.map showGhc) d1)---hsFreeAndDeclaredPNs :: (SYB.Data t) => t -> RefactGhc ([GHC.Name],[GHC.Name])-hsFreeAndDeclaredPNs t = do-  -- logm $ "hsFreeAndDeclaredPNs:t=" ++ (showGhc t)-  (FN f,DN d) <- hsFreeAndDeclaredGhc t-  return (f,d)---- ------------------------------------------------------------------------- | Collect the free and declared variables (in the GHC.Name format)--- in a given syntax phrase t. In the result, the first list contains--- the free variables, and the second list contains the declared--- variables.--- TODO: use GHC.NameSet instead of lists for FreeNames/DeclaredNames--- NOTE: The GHC fvs fields only carry non-GHC values, as they are--- used in the renaming process--- hsFreeAndDeclaredGhc :: (SYB.Data t,GHC.Outputable t)-hsFreeAndDeclaredGhc :: (SYB.Data t)-                     => t -> RefactGhc (FreeNames,DeclaredNames)-hsFreeAndDeclaredGhc t = do-  -- logm $ "hsFreeAndDeclaredGhc:t=" ++ showGhc t-  -- logm $ "hsFreeAndDeclaredGhc:t=" ++ SYB.showData SYB.Renamer 0 t-  (FN f,DN d) <- res-  let f' = nub f-  let d' = nub d-  -- logm $ "hsFreeAndDeclaredGhc:res=" ++ showGhc (f',d')-  return (FN (f' \\ d'), DN d')--  where-    res = (const err-          `SYB.extQ` renamed-          `SYB.extQ` lhsbind-          `SYB.extQ` hsbind-          `SYB.extQ` lhsbinds-          `SYB.extQ` lhsbindslrs-          `SYB.extQ` lhsbindslr-          `SYB.extQ` hslocalbinds-          `SYB.extQ` hsvalbinds-          `SYB.extQ` lpats-          `SYB.extQ` lpat-          `SYB.extQ` bndrs-          `SYB.extQ` ltydecls-          `SYB.extQ` ltydecl-          -- `SYB.extQ` lfaminstdecls-          -- `SYB.extQ` lfaminstdecl-          `SYB.extQ` lsigs-          `SYB.extQ` lsig-          `SYB.extQ` lexprs-          `SYB.extQ` lexpr-          `SYB.extQ` expr-          `SYB.extQ` name-          `SYB.extQ` lstmts-          `SYB.extQ` lstmt-          `SYB.extQ` lhstype-          `SYB.extQ` hstype-          `SYB.extQ` grhs_s-          `SYB.extQ` grhs-          `SYB.extQ` grhsss-          `SYB.extQ` grhss-          `SYB.extQ` matchgroup-          `SYB.extQ` lmatches-          `SYB.extQ` lmatch-          `SYB.extQ` hsrecordbinds-          `SYB.extQ` hsrecordbind-          ) t--    -- -------------------------    renamed :: GHC.RenamedSource ->  RefactGhc (FreeNames,DeclaredNames)-    renamed (g,_i,_e,_d) = do-      (FN gf,DN gd) <- hsFreeAndDeclaredGhc $ GHC.hs_valds g-      let tds = concatMap getDeclaredTypes $ concatMap GHC.group_tyclds (GHC.hs_tyclds g)-      logm $ "hsFreeAndDeclaredGhc.renamed:(gf,gd,tds)=" ++ showGhc (gf,gd,tds)-      -- return $ gfds <> (FN [],DN tds)-      return $ (FN (gf \\ tds), DN (gd++tds))--    -- -------------------------    lhsbinds :: [GHC.LHsBind GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lhsbinds bs = do-      (FN f,DN d) <- recurseList bs-      let r = (FN (f \\ d),DN d)-      -- logm $ "hsFreeAndDeclaredGhc.hsbinds:r=" ++ (show r)-      return r--    lhsbind :: GHC.LHsBind GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lhsbind (GHC.L _ b) = hsFreeAndDeclaredGhc b--    -- -------------------------    hsbind :: GHC.HsBind GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    hsbind b@(GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _) = do-        -- logm $ "hsFreeAndDeclaredGhc.hsbind:b=" ++ (showGhc b)-        let d = GHC.collectHsBindBinders b-        (fp,_dp) <- hsFreeAndDeclaredGhc matches-        -- logm $ "hsFreeAndDeclaredGhc.hsbind:(fp,_dp)=" ++ (show (fp,_dp))-        -- logm $ "hsFreeAndDeclaredGhc.hsbind:(d)=" ++ (showGhc (d))-        let r = (fp,DN []) <> (FN [],DN d)-        -- logm $ "hsFreeAndDeclaredGhc.hsbind:r=" ++ (show (r))-        return $ r-    hsbind b@(GHC.PatBind pa rhs _ _ _) = do-        -- logm $ "hsFreeAndDeclaredGhc.hsbind.PatBind:b=" ++ (showGhc b)-        let d = GHC.collectHsBindBinders b-        (FN fr,DN _dr) <- hsFreeAndDeclaredGhc rhs-        (fp,_) <- lpat pa-        -- logm $ "hsFreeAndDeclaredGhc.hsbind.PatBind:f=" ++ (showGhc fr)-        return $ (fp,DN []) <> (FN fr,DN d)-    hsbind b = do-        -- logm $ "hsFreeAndDeclaredGhc.hsbind:b=" ++ (showGhc b)-        let d = GHC.collectHsBindBinders b-        return (FN [],DN d)--    -- -------------------------    lhsbindslrs :: [GHC.LHsBindsLR GHC.Name GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lhsbindslrs bs = recurseList bs--    -- -------------------------    lhsbindslr :: GHC.LHsBindsLR GHC.Name GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lhsbindslr bs = do-      hsFreeAndDeclaredGhc $ GHC.bagToList bs--    hslocalbinds :: GHC.HsLocalBinds GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    hslocalbinds (GHC.HsValBinds binds) = hsFreeAndDeclaredGhc binds-    hslocalbinds (GHC.HsIPBinds binds)  = hsFreeAndDeclaredGhc binds-    hslocalbinds GHC.EmptyLocalBinds    = return emptyFD---    hsvalbinds :: GHC.HsValBinds GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    hsvalbinds (GHC.ValBindsIn binds sigs) = do-      bfds <- hsFreeAndDeclaredGhc binds-      sfds <- hsFreeAndDeclaredGhc sigs-      return $ bfds <> sfds-    hsvalbinds (GHC.ValBindsOut binds sigs) = do-      bfds <- hsFreeAndDeclaredGhc $ map snd binds-      sfds <- hsFreeAndDeclaredGhc sigs-      return $ bfds <> sfds--    -- -------------------------    lpats :: [GHC.LPat GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lpats xs = recurseList xs--    -- -------------------------    lpat :: GHC.LPat GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lpat lp@(GHC.L _ p) = do-      -- logm $ "hsFreeAndDeclaredGhc.lpat:" ++ (showGhc lp)-      let-        d = GHC.collectPatBinders lp--      (FN f,DN _dn) <- pat p-      -- logm $ "hsFreeAndDeclaredGhc.lpat:(fn,dn)=" ++ (showGhc (fn,dn))-      return (FN f,DN d)--    pat :: GHC.Pat GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    pat (GHC.WildPat _) = return emptyFD-    pat (GHC.VarPat n) = return (FN [],DN [n])-    pat (GHC.LazyPat (GHC.L _ p)) = pat p-    pat (GHC.AsPat (GHC.L _ n) (GHC.L _ p)) = do-      fd <- pat p-      return $ (FN [], DN [n]) <> fd-    pat (GHC.ParPat (GHC.L _ p)) = pat p-    pat (GHC.BangPat (GHC.L _ p)) = pat p-    pat (GHC.ListPat ps _ _) = do-      fds <- mapM pat $ map GHC.unLoc ps-      return $ mconcat fds-    pat (GHC.TuplePat ps _ _) = do-      fds <- mapM pat $ map GHC.unLoc ps-      return $ mconcat fds-    pat (GHC.PArrPat ps _) = do-      fds <- mapM pat $ map GHC.unLoc ps-      return $ mconcat fds-    pat (GHC.ConPatIn (GHC.L _ n) det) = do-      -- logm $ "hsFreeAndDeclaredGhc.pat.ConPatIn:details=" ++ (SYB.showData SYB.Renamer 0 det)-      (FN f,DN _d) <- details det-      return $ (FN [n],DN []) <> (FN [],DN f)-    -- pat (GHC.ConPatOut )-    pat (GHC.ViewPat e (GHC.L _ p) _) = do-      fde <- hsFreeAndDeclaredGhc e-      fdp <- pat p-      return $ fde <> fdp-    -- pat (GHC.QuasiQuotePat _)-    pat (GHC.LitPat _) = return emptyFD-    pat (GHC.NPat _ _ _) = return emptyFD-    pat (GHC.NPlusKPat (GHC.L _ n) _ _ _) = return (FN [],DN [n])-    pat _p@(GHC.SigPatIn (GHC.L _ p) b) = do-      fdp <- pat p-      (FN fb,DN _db) <- hsFreeAndDeclaredGhc b-      return $ fdp <> (FN fb,DN [])-    pat (GHC.SigPatOut (GHC.L _ p) _) = pat p-    pat (GHC.CoPat _ p _) = pat p--    pat p = error $ "hsFreeAndDeclaredGhc.pat:unimplemented:" ++ (showGhc p)--    details :: GHC.HsConPatDetails GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    details (GHC.PrefixCon  args) = do-      -- logm $ "hsFreeAndDeclaredGhc.details:args=" ++ (showGhc args)-      fds <- mapM pat $ map GHC.unLoc args-      return $ mconcat fds-    details (GHC.RecCon recf) =-      recfields recf-    details (GHC.InfixCon arg1 arg2) = do-      fds <- mapM pat $ map GHC.unLoc [arg1,arg2]-      return $ mconcat fds--    -- Note: this one applies to HsRecFields in LPats-    recfields :: (GHC.HsRecFields GHC.Name (GHC.LPat GHC.Name)) -> RefactGhc (FreeNames,DeclaredNames)-    recfields (GHC.HsRecFields fields _) = do-      let args = map (\(GHC.L _ (GHC.HsRecField _ (GHC.L _ arg) _)) -> arg) fields-      fds <- mapM pat args-      return $ mconcat fds--    -- -------------------------    bndrs :: GHC.HsWithBndrs GHC.Name (GHC.LHsType GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    bndrs (GHC.HsWB (GHC.L _ thing) _ _ _) = do-      (_ft,DN dt) <- hsFreeAndDeclaredGhc thing-      -- logm $ "hsFreeAndDeclaredGhc.bndrs (_ft,dt)=" ++ show (_ft,DN dt)-      return (FN dt,DN [])-    -- -------------------------    ltydecls :: [GHC.LTyClDecl GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    ltydecls ds = do-      fds <- mapM hsFreeAndDeclaredGhc ds-      return $ mconcat fds--    ltydecl :: GHC.LTyClDecl GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    -- ltydecl (GHC.L _ (GHC.ForeignType (GHC.L _ n) _)) = return (FN [],DN [n])--    -- ltydecl (GHC.L _ (GHC.TyFamily _ (GHC.L _ n) _bndrs _)) = return (FN [],DN [n])-    ltydecl (GHC.L _ (GHC.FamDecl fd)) = hsFreeAndDeclaredGhc fd-    ltydecl (GHC.L _ (GHC.SynDecl (GHC.L _ n) _bndrs _rhs fvs))-        = return (FN (GHC.nameSetElems fvs),DN [n])-    ltydecl (GHC.L _ (GHC.DataDecl (GHC.L _ n) _bndrs defn fvs)) = do-        let dds = map GHC.unLoc $ concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn-        logm $ "hsFreeAndDeclaredGhc.ltydecl:(n,dds)" ++ showGhc (n,dds)-        return (FN (GHC.nameSetElems fvs),DN (n:dds))-    ltydecl (GHC.L _ (GHC.ClassDecl _ctx (GHC.L _ n) _tyvars-                     _fds _sigs meths ats atds _docs fvs)) = do-       -- logm $ "hsFreeAndDeclaredGhc.ltydecl.ClassDecl.meths"-       (_,md) <- hsFreeAndDeclaredGhc meths-       -- logm $ "hsFreeAndDeclaredGhc.ltydecl.ClassDecl.ats"-       (_,ad) <- hsFreeAndDeclaredGhc ats-       -- logm $ "hsFreeAndDeclaredGhc.ltydecl.ClassDecl.atds"-       (_,atd) <- hsFreeAndDeclaredGhc atds-       -- logm $ "hsFreeAndDeclaredGhc.ltydecl.ClassDecl.done"-       return (FN (GHC.nameSetElems fvs),DN [n] <> md <> ad <> atd)-{--FamDecl -- type/data family T :: *->*-  tcdFam :: FamilyDecl name--SynDecl  -- type declaration-  tcdLName :: Located name-  tcdTyVars :: LHsTyVarBndrs name-  tcdRhs :: LHsType name-  tcdFVs :: PostRn name NameSet--DataDecl-  tcdLName :: Located name-  tcdTyVars :: LHsTyVarBndrs name-  tcdDataDefn :: HsDataDefn name-  tcdFVs :: PostRn name NameSet--ClassDecl-  tcdCtxt :: LHsContext name-  tcdLName :: Located name-  tcdTyVars :: LHsTyVarBndrs name-  tcdFDs :: [Located (FunDep (Located name))]-  tcdSigs :: [LSig name]-  tcdMeths :: LHsBinds name-  tcdATs :: [LFamilyDecl name]-  tcdATDefs :: [LTyFamDefltEqn name]-  tcdDocs :: [LDocDecl]-  tcdFVs :: PostRn name NameSet----}--    -- ----------------------------------{--    lfaminstdecls :: [GHC.LFamInstDecl GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lfaminstdecls ds = do-      fds <- mapM hsFreeAndDeclaredGhc ds-      return $ mconcat fds--    lfaminstdecl :: GHC.LFamInstDecl GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lfaminstdecl _f@(GHC.L _ (GHC.FamInstDecl (GHC.L _ n) _pats _defn fvs)) = do-      -- logm $ "hsFreeAndDeclaredGhc.lfaminstdecl:" ++ showGhc _f-      return (FN (GHC.nameSetElems fvs), DN [n])--}-    -- -------------------------    lsigs :: [GHC.LSig GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lsigs ss = do-      fds <- mapM hsFreeAndDeclaredGhc ss-      return $ mconcat fds--    -- -------------------------    lsig :: GHC.LSig GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lsig (GHC.L _ (GHC.TypeSig ns typ _)) = do-      tfds <- hsFreeAndDeclaredGhc typ-      return $ (FN [],DN (map GHC.unLoc ns)) <> tfds-    lsig (GHC.L _ (GHC.GenericSig n typ)) = do-      tfds <- hsFreeAndDeclaredGhc typ-      return $ (FN [],DN (map GHC.unLoc n)) <> tfds-    lsig (GHC.L _ (GHC.IdSig _)) = return emptyFD-    lsig (GHC.L _ (GHC.InlineSig _ _)) = return emptyFD-    lsig (GHC.L _ (GHC.SpecSig n typ _)) = do-      tfds <- hsFreeAndDeclaredGhc typ-      return $ (FN [],DN [GHC.unLoc n]) <> tfds-    lsig (GHC.L _ (GHC.SpecInstSig _ _)) = return emptyFD-    lsig (GHC.L _ (GHC.FixSig _)) = return emptyFD-    lsig (GHC.L _ (GHC.PatSynSig _ _ _ _ _)) = error "lsig: PatSynSig: toImplement"-    lsig (GHC.L _ (GHC.MinimalSig _ _)) = error "lsig FixSig: toImplement"--    -- -------------------------    lexprs :: [GHC.LHsExpr GHC.Name] -> RefactGhc (FreeNames,DeclaredNames)-    lexprs es = recurseList es--    -- -------------------------    lexpr :: GHC.LHsExpr GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lexpr (GHC.L _ e) = hsFreeAndDeclaredGhc e--    -- -------------------------    expr :: GHC.HsExpr GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    expr ((GHC.HsVar n)) = return (FN [n],DN [])--    expr ((GHC.HsIPVar _)) = return emptyFD--    expr ((GHC.HsOverLit _)) = return emptyFD--    expr ((GHC.HsLit _)) = return emptyFD--    expr ((GHC.HsLam mg)) = hsFreeAndDeclaredGhc mg--    expr ((GHC.HsLamCase _ mg)) = hsFreeAndDeclaredGhc mg--    expr ((GHC.HsApp e1 e2)) = do-      fde1 <- hsFreeAndDeclaredGhc e1-      fde2 <- hsFreeAndDeclaredGhc e2-      return $ fde1 <> fde2--    expr ((GHC.OpApp e1 eop _fix e2)) = do-      fde1 <- hsFreeAndDeclaredGhc e1-      fdeop <- hsFreeAndDeclaredGhc eop-      fde2 <- hsFreeAndDeclaredGhc e2-      return $ fde1 <> fdeop <> fde2--    expr ((GHC.NegApp e _)) = hsFreeAndDeclaredGhc e--    expr ((GHC.HsPar e)) = hsFreeAndDeclaredGhc e--    expr ((GHC.SectionL e1 e2)) = do-      fde1 <- hsFreeAndDeclaredGhc e1-      fde2 <- hsFreeAndDeclaredGhc e2-      return $ fde1 <> fde2--    expr ((GHC.SectionR e1 e2)) = do-      fde1 <- hsFreeAndDeclaredGhc e1-      fde2 <- hsFreeAndDeclaredGhc e2-      return $ fde1 <> fde2--    expr ((GHC.ExplicitTuple args _boxity)) = do-      let argse = concatMap bb args-          bb (GHC.L _ (GHC.Missing _)) = []-          bb (GHC.L _ (GHC.Present a)) = [a]--      fds <- mapM hsFreeAndDeclaredGhc argse-      return $ mconcat fds--    expr ((GHC.HsCase e body)) = do-       fdes <- hsFreeAndDeclaredGhc e-       fdbs <- hsFreeAndDeclaredGhc body-       return $ fdes <> fdbs--    expr ((GHC.HsIf _ms e1 e2 e3)) = do-      fde1 <- hsFreeAndDeclaredGhc e1-      fde2 <- hsFreeAndDeclaredGhc e2-      fde3 <- hsFreeAndDeclaredGhc e3-      return $ fde1 <> fde2 <> fde3--    expr ((GHC.HsMultiIf _typ rhs))-      = hsFreeAndDeclaredGhc rhs--    expr ((GHC.HsLet binds e)) = do-      fdb <- hsFreeAndDeclaredGhc binds-      fde <- hsFreeAndDeclaredGhc e-      return $ fdb <> fde--    expr ((GHC.HsDo _ctx stmts _typ))-      = hsFreeAndDeclaredGhc stmts--    expr ((GHC.ExplicitList _ _ es))-      = hsFreeAndDeclaredGhc es--    expr ((GHC.ExplicitPArr _typ es))-      = hsFreeAndDeclaredGhc es--    expr ((GHC.RecordCon (GHC.L _ n) _typ binds)) = do-      fdb <- hsFreeAndDeclaredGhc binds-      return $ (FN [],DN [n]) <> fdb--    expr ((GHC.RecordUpd e1 binds _cons _typ1 _typ2)) = do-      fde <- hsFreeAndDeclaredGhc e1-      fdb <- hsFreeAndDeclaredGhc binds-      return $ fde <> fdb--    expr ((GHC.ExprWithTySig e _typ _))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.ExprWithTySigOut e _typ))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.ArithSeq _ _typ as)) = do-      fds <- case as of-        GHC.From e -> hsFreeAndDeclaredGhc e-        GHC.FromThen e1 e2      -> recurseList [e1,e2]-        GHC.FromTo e1 e2        -> recurseList [e1,e2]-        GHC.FromThenTo e1 e2 e3 -> recurseList [e1,e2,e3]-      return fds--    expr ((GHC.PArrSeq _typ as))-      = hsFreeAndDeclaredGhc as--    expr ((GHC.HsSCC _ _ e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsCoreAnn _ _ e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsBracket (GHC.ExpBr b)))-      = hsFreeAndDeclaredGhc b-    expr ((GHC.HsBracket (GHC.PatBr b)))-      = hsFreeAndDeclaredGhc b-    expr ((GHC.HsBracket (GHC.DecBrL b)))-      = hsFreeAndDeclaredGhc b-    expr ((GHC.HsBracket (GHC.DecBrG b)))-      = hsFreeAndDeclaredGhc b-    expr ((GHC.HsBracket (GHC.TypBr b)))-      = hsFreeAndDeclaredGhc b-    expr ((GHC.HsBracket (GHC.VarBr _ n)))-      = return (FN [],DN [n])-    expr ((GHC.HsBracket (GHC.TExpBr _)))-      = error "expr: GHC.HsBracket (GHC.TExpBr), to implement"--    expr ((GHC.HsRnBracketOut b _ps))-      = hsFreeAndDeclaredGhc b--    expr ((GHC.HsTcBracketOut b _ps))-      = hsFreeAndDeclaredGhc b--    expr ((GHC.HsSpliceE _ (GHC.HsSplice _ e)))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsQuasiQuoteE _q))-      = return emptyFD--    expr ((GHC.HsProc pa cmd)) = do-      fdp <- hsFreeAndDeclaredGhc pa-      fdc <- hsFreeAndDeclaredGhc cmd-      return $ fdp <> fdc--    expr ((GHC.HsStatic e)) = hsFreeAndDeclaredGhc e--    expr ((GHC.HsArrApp e1 e2 _typ _atyp _)) = do-      fd1 <- hsFreeAndDeclaredGhc e1-      fd2 <- hsFreeAndDeclaredGhc e2-      return $ fd1 <> fd2--    expr ((GHC.HsArrForm e1 _fix cmds)) = do-      fd1 <- hsFreeAndDeclaredGhc e1-      fdc <- hsFreeAndDeclaredGhc cmds-      return $ fd1 <> fdc--    expr ((GHC.HsTick _ e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsBinTick _ _ e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsTickPragma _ _ e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.EWildPat)) = return emptyFD--    expr ((GHC.EAsPat (GHC.L _ n) e)) = do-      fde <- hsFreeAndDeclaredGhc e-      return $ (FN [],DN [n]) <> fde--    expr ((GHC.EViewPat e1 e2)) = do-      fd1 <- hsFreeAndDeclaredGhc e1-      fd2 <- hsFreeAndDeclaredGhc e2-      return $ fd1 <> fd2--    expr ((GHC.ELazyPat e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsType typ))-      = hsFreeAndDeclaredGhc typ--    expr ((GHC.HsWrap _wrap e))-      = hsFreeAndDeclaredGhc e--    expr ((GHC.HsUnboundVar _)) = return emptyFD--    -- -------------------------    name :: GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    name n = return (FN [],DN [n])--    -- ------------------------    lstmts :: [GHC.LStmt GHC.Name (GHC.LHsExpr GHC.Name)] -> RefactGhc (FreeNames,DeclaredNames)-    lstmts ss = recurseList ss---    lstmt :: GHC.LStmt GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    lstmt (GHC.L _ (GHC.LastStmt e _)) = hsFreeAndDeclaredGhc e-    lstmt (GHC.L _ (GHC.BindStmt pa e _ _)) = do-      fdp <- hsFreeAndDeclaredGhc pa-      fde <- hsFreeAndDeclaredGhc e-      return (fdp <> fde)-    lstmt (GHC.L _ (GHC.BodyStmt e _ _ _)) = hsFreeAndDeclaredGhc e-    -- lstmt (GHC.L _ (GHC.ExprStmt e _ _ _)) = hsFreeAndDeclaredGhc e--    lstmt (GHC.L _ (GHC.LetStmt bs)) = hsFreeAndDeclaredGhc bs-    lstmt (GHC.L _ (GHC.ParStmt ps _ _)) = hsFreeAndDeclaredGhc ps-    lstmt (GHC.L _ (GHC.TransStmt _ stmts _ using mby _ _ _)) = do-      fds <- hsFreeAndDeclaredGhc stmts-      fdu <- hsFreeAndDeclaredGhc using-      fdb <- case mby of-        Nothing -> return emptyFD-        Just e -> hsFreeAndDeclaredGhc e-      return $ fds <> fdu <> fdb-    lstmt (GHC.L _ (GHC.RecStmt stmts _ _ _ _ _ _ _ _)) = hsFreeAndDeclaredGhc stmts--    -- -------------------------    lhstype :: GHC.LHsType GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    lhstype (GHC.L _ typ) = hstype typ--    -- -------------------------    hstype :: GHC.HsType GHC.Name -> RefactGhc (FreeNames,DeclaredNames)-    hstype (GHC.HsForAllTy _ _ _ _ typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsTyVar n) = return (FN [],DN [n])-    hstype (GHC.HsAppTy t1 t2) = recurseList [t1,t2]-    hstype (GHC.HsFunTy t1 t2) = recurseList [t1,t2]-    hstype (GHC.HsListTy typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsPArrTy typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsTupleTy _ typs) = recurseList typs-    hstype (GHC.HsOpTy t1 _ t2) = recurseList [t1,t2]-    hstype (GHC.HsParTy typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsIParamTy _ typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsEqTy t1 t2) = recurseList [t1,t2]-    hstype (GHC.HsKindSig t1 t2) = recurseList [t1,t2]-    hstype (GHC.HsQuasiQuoteTy _) = return emptyFD-    hstype (GHC.HsSpliceTy _ _) = return (FN [],DN [])-    hstype (GHC.HsDocTy _ typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsBangTy _ typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsRecTy cons) = recurseList cons-    hstype (GHC.HsCoreTy _) = return emptyFD-    hstype (GHC.HsExplicitListTy _ typs) = recurseList typs-    hstype (GHC.HsExplicitTupleTy _ typs) = recurseList typs-    hstype (GHC.HsTyLit _) = return emptyFD-    hstype (GHC.HsWrapTy _ typ) = hsFreeAndDeclaredGhc typ-    hstype (GHC.HsWildcardTy) = error "To implement: hstype, HsWildcardTy"-    hstype (GHC.HsNamedWildcardTy _) = error "To implement: HsNamedWildcardTy"----    -- -------------------------    grhs_s :: [GHC.LGRHS GHC.Name (GHC.LHsExpr GHC.Name)] -> RefactGhc (FreeNames,DeclaredNames)-    grhs_s gs = recurseList gs--    -- -------------------------    grhs :: GHC.LGRHS GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    grhs (GHC.L _ (GHC.GRHS stmts e)) = do-      fds <- hsFreeAndDeclaredGhc stmts-      fde <- hsFreeAndDeclaredGhc e-      return $ fds <> fde--    -- -------------------------    grhsss :: [GHC.GRHSs GHC.Name (GHC.LHsExpr GHC.Name)] -> RefactGhc (FreeNames,DeclaredNames)-    grhsss gs = recurseList gs--    -- -------------------------    grhss :: GHC.GRHSs GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    grhss (GHC.GRHSs g binds) = do-      (fg,_dg) <- hsFreeAndDeclaredGhc g-      fdb <- hsFreeAndDeclaredGhc binds-      return $  (fg,DN[]) <> fdb--    -- -------------------------    matchgroup :: GHC.MatchGroup GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    matchgroup (GHC.MG matches _ _ _) = recurseList matches--    -- -------------------------    lmatches :: [GHC.LMatch GHC.Name (GHC.LHsExpr GHC.Name)] -> RefactGhc (FreeNames,DeclaredNames)-    lmatches ms = recurseList ms--    -- -------------------------    lmatch :: GHC.LMatch GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    lmatch (GHC.L _ _m@(GHC.Match _fn pats _ rhs)) = do-      (fp,DN dp) <- recurseList pats-      (FN fr,DN dr) <- hsFreeAndDeclaredGhc rhs-      let r = (fp,DN []) <> (FN (fr \\ (dr ++ dp)), DN [])-      return $ r--    -- -------------------------    hsrecordbinds :: (GHC.HsRecordBinds GHC.Name) -> RefactGhc (FreeNames,DeclaredNames)-    hsrecordbinds (GHC.HsRecFields fields _) = recurseList fields--    hsrecordbind :: (GHC.HsRecField GHC.Name (GHC.LHsExpr GHC.Name)) -> RefactGhc (FreeNames,DeclaredNames)-    hsrecordbind (GHC.HsRecField (GHC.L _ n) arg _) = do-      fda <- hsFreeAndDeclaredGhc arg-      return $ (FN [n],DN []) <> fda--    -- -------------------------    err = do-      logm $ "hsFreeAndDeclaredGhc:not matched:"-               ++ show (annGetConstr t) ++ ":"-               ++ (SYB.showData SYB.Renamer 0 t)-      return emptyFD--    -- -----------------------------------    recurseList xs = do-      fds <- mapM hsFreeAndDeclaredGhc xs-      return $ mconcat fds----- ------------------------------------------------------------------------- |Get the names of all types declared in the given declaration--- getDeclaredTypesRdr :: GHC.LTyClDecl GHC.RdrName -> RefactGhc [GHC.Name]-getDeclaredTypesRdr :: GHC.LHsDecl GHC.RdrName -> RefactGhc [GHC.Name]-getDeclaredTypesRdr (GHC.L _ (GHC.TyClD decl)) = do-  nm <- getRefactNameMap-  case decl of-    (GHC.FamDecl (GHC.FamilyDecl _ ln _ _)) -> return [rdrName2NamePure nm ln]-    (GHC.SynDecl ln  _ _ _) -> return [rdrName2NamePure nm ln]-    (GHC.DataDecl ln _ defn _) -> do-      let dds = concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn-      let ddns = map (rdrName2NamePure nm) dds-      return $ [rdrName2NamePure nm ln] ++ ddns--    (GHC.ClassDecl _ ln _vars _fds sigs meths ats _atdefs _ _fvs) -> do-      -- msn <- getMsn meths-      let msn = getDeclaredVarsRdr nm (map wrapDecl $ GHC.bagToList meths)-      let fds = map (GHC.fdLName . GHC.unLoc) ats-          fds' = map (rdrName2NamePure nm) fds-      return $ nub $ [rdrName2NamePure nm ln] ++ ssn ++ msn ++ fds' -- ++ asn-      where-        getLSig :: GHC.LSig GHC.RdrName -> [GHC.Name]-        getLSig (GHC.L _ (GHC.TypeSig ns _ _))  = map (rdrName2NamePure nm) ns-        getLSig (GHC.L _ (GHC.GenericSig ns _)) = map (rdrName2NamePure nm) ns-        getLSig (GHC.L _ (GHC.IdSig _n)) = []-        getLSig (GHC.L _ (GHC.InlineSig ln2 _)) = [rdrName2NamePure nm ln2]-        getLSig (GHC.L _ (GHC.SpecSig ln2 _ _)) = [rdrName2NamePure nm ln2]-        getLSig (GHC.L _ (GHC.SpecInstSig _ _)) = []-        getLSig (GHC.L _ (GHC.FixSig _)) = []-        getLSig (GHC.L _ (GHC.PatSynSig _ _ _ _ _)) = error "To implement: getLSig PatSynSig"-        getLSig (GHC.L _ (GHC.MinimalSig _ _)) = error "To implement: getLSig PatSynSig"--        ssn = concatMap getLSig sigs-        -- msn = getDeclaredVars $ hsBinds meths-getDeclaredTypesRdr _ = return []---- |Get the names of all types declared in the given declaration-getDeclaredTypes :: GHC.LTyClDecl GHC.Name -> [GHC.Name]-getDeclaredTypes (GHC.L _ (GHC.FamDecl (GHC.FamilyDecl _ (GHC.L _ n) _ _))) = [n]-getDeclaredTypes (GHC.L _ (GHC.SynDecl (GHC.L _ n)  _ _ _)) = [n]-getDeclaredTypes (GHC.L _ (GHC.DataDecl (GHC.L _ n) _ defn _)) = n:dds-  where dds = map GHC.unLoc $ concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn-getDeclaredTypes (GHC.L _ (GHC.ClassDecl _ (GHC.L _ n) _vars _fds sigs meths _ats _atdefs _ _fvs))-  = nub $ [n] ++ ssn ++ msn -- ++ asn-  where-    getLSig :: GHC.LSig GHC.Name -> [GHC.Name]-    getLSig (GHC.L _ (GHC.TypeSig ns _ _)) = map GHC.unLoc ns-    getLSig (GHC.L _ (GHC.GenericSig ns _)) = map GHC.unLoc ns-    getLSig (GHC.L _ (GHC.IdSig _n)) = []-    getLSig (GHC.L _ (GHC.InlineSig (GHC.L _ n2) _)) = [n2]-    getLSig (GHC.L _ (GHC.SpecSig (GHC.L _ n2) _ _)) = [n2]-    getLSig (GHC.L _ (GHC.SpecInstSig _ _)) = []-    getLSig (GHC.L _ (GHC.FixSig _)) = []-    getLSig (GHC.L _ (GHC.PatSynSig _ _ _ _ _)) = error "To implement: getLSig PatSynSig"-    getLSig (GHC.L _ (GHC.MinimalSig _ _)) = error "To implement: getLSig PatSynSig"--    ssn = concatMap getLSig sigs-    msn = getDeclaredVars $ hsBinds meths---- ------------------------------------------------------------------------- | Return the list of identifiers (in PName format) defined by a--- function\/pattern binding.-definedPNs :: GHC.LHsBind GHC.Name -> [GHC.Name]-definedPNs (GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ _ _)) = [pname]-definedPNs (GHC.L _ (GHC.PatBind p _rhs _ty _fvs _))         = (hsNamess p)-definedPNs (GHC.L _ (GHC.VarBind pname _rhs _))              = [pname]---- AbsBinds and ValBinds will never occur in ParsedSource-definedPNs  _ = []--definedPNsRdr :: GHC.LHsDecl GHC.RdrName -> [GHC.Located GHC.RdrName]-definedPNsRdr (GHC.L _ (GHC.ValD (GHC.FunBind pname _ _ _ _ _)))   = [pname]-definedPNsRdr (GHC.L _ (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) = (hsNamessRdr p)--- VarBind will never occur in ParsedSource--- TODO: what about GHC.AbsBinds?-definedPNsRdr  _ = []---- -----------------------------------------------------------------------definedNamesRdr :: NameMap -> GHC.LHsDecl GHC.RdrName -> [GHC.Name]-definedNamesRdr nameMap bind = map (rdrName2NamePure nameMap) (definedPNsRdr bind)---- ------------------------------------------------------------------------- |Find those declarations(function\/pattern binding) which define--- the specified GHC.Names. incTypeSig indicates whether the--- corresponding type signature will be included.-definingDeclsRdrNames::-            NameMap-            ->[GHC.Name]   -- ^ The specified identifiers.-            ->[GHC.LHsDecl GHC.RdrName] -- ^ A collection of declarations.-            ->Bool       -- ^ True means to include the type signature.-            ->Bool       -- ^ True means to look at the local declarations as well.-            ->[GHC.LHsDecl GHC.RdrName]  -- ^ The result.-definingDeclsRdrNames nameMap pns ds _incTypeSig recursive = concatMap defining ds--- ++AZ++:TODO: now we are processing decls again, reinstate incTypeSig function-  where-   defining decl-     = if recursive-        then SYB.everythingStaged SYB.Parser (++) [] ([]  `SYB.mkQ` definesDecl `SYB.extQ` definesBind)  decl-        else definesDecl decl-     where-      definesDecl :: (GHC.LHsDecl GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]-      definesDecl decl'@(GHC.L _ (GHC.ValD (GHC.FunBind _ _ _ _ _ _)))-        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']--      definesDecl decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))-        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']--      definesDecl _ = []--      definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]-      definesBind (GHC.L l b) = definesDecl (GHC.L l (GHC.ValD b))---- ------------------------------------------------------------------------- |Find those declarations(function\/pattern binding) which define--- the specified GHC.Names. incTypeSig indicates whether the corresponding type--- signature will be included.-definingDeclsRdrNames' :: (SYB.Data t)-            => NameMap-            -> [GHC.Name]   -- ^ The specified identifiers.-            -> t            -- ^ A collection of declarations.-            -> [GHC.LHsDecl GHC.RdrName]  -- ^ The result.-definingDeclsRdrNames' nameMap pns ds = defining ds-  where-   defining decl-     = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` defines' `SYB.extQ` definesBind) decl-     where-      defines' :: (GHC.LHsDecl GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]-      defines' decl'@(GHC.L _ (GHC.ValD (GHC.FunBind _ _ _ _ _ _)))-        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']--      defines' decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))-        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']--      defines' _ = []--      definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]-      definesBind (GHC.L l b) = defines' (GHC.L l (GHC.ValD b))---- ------------------------------------------------------------------------- |Find those declarations(function\/pattern binding) which define--- the specified GHC.Names. incTypeSig indicates whether the--- corresponding type signature will be included.-definingDeclsNames::-            [GHC.Name]   -- ^ The specified identifiers.-            ->[GHC.LHsBind GHC.Name] -- ^ A collection of declarations.-            ->Bool       -- ^ True means to include the type signature.-            ->Bool       -- ^ True means to look at the local declarations as well.-            ->[GHC.LHsBind GHC.Name]  -- ^ The result.-definingDeclsNames pns ds _incTypeSig recursive = concatMap defining ds-  where-   defining decl-     = if recursive-        then SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` defines') decl-        else defines' decl-     where-      defines' :: (GHC.LHsBind GHC.Name) -> [GHC.LHsBind GHC.Name]-      defines' decl'@(GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ _ _))-        |isJust (find (==(pname)) pns) = [decl']--      defines' decl'@(GHC.L _l (GHC.PatBind p _rhs _ty _fvs _))-        |(hsNamess p) `intersect` pns /= [] = [decl']--      defines' _ = []---- |Find those declarations(function\/pattern binding) which define--- the specified GHC.Names. incTypeSig indicates whether the--- corresponding type signature will be included.-definingDeclsNames':: (SYB.Data t)-            => [GHC.Name]   -- ^ The specified identifiers.-            -> t            -- ^ A collection of declarations.-            ->[GHC.LHsBind GHC.Name]  -- ^ The result.-definingDeclsNames' pns t = defining t-  where-   defining decl-     = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` defines') decl-     where-      defines' :: (GHC.LHsBind GHC.Name) -> [GHC.LHsBind GHC.Name]-      defines' decl'@(GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ _ _))-        |isJust (find (==(pname)) pns) = [decl']--      defines' decl'@(GHC.L _l (GHC.PatBind p _rhs _ty _fvs _))-        |(hsNamess p) `intersect` pns /= [] = [decl']--      defines' _ = []---- ------------------------------------------------------------------------- |Find those type signatures for the specified GHC.Names.-definingSigsNames :: (SYB.Data t) =>-            [GHC.Name] -- ^ The specified identifiers.-            ->t        -- ^ A collection of declarations.-            ->[GHC.LSig GHC.Name]  -- ^ The result.-definingSigsNames pns ds = def ds-  where-   def decl-     = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` inSig) decl-     where-      inSig :: (GHC.LSig GHC.Name) -> [GHC.LSig GHC.Name]-      inSig (GHC.L l (GHC.TypeSig ns t p))-       | defines' ns /= [] = [(GHC.L l (GHC.TypeSig (defines' ns) t p))]-      inSig _ = []--      defines' (p::[GHC.Located GHC.Name])-        = filter (\(GHC.L _ n) -> n `elem` pns) p---- ------------------------------------------------------------------------- |Find those type signatures for the specified GHC.Names.-definingSigsRdrNames :: (SYB.Data t) =>-            NameMap-            ->[GHC.Name] -- ^ The specified identifiers.-            ->t        -- ^ A collection of declarations.-            ->[GHC.LSig GHC.RdrName]  -- ^ The result.-definingSigsRdrNames nameMap pns ds = def ds-  where-   def decl-     -- = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` inSig) decl-     = SYB.everything (++) ([]  `SYB.mkQ` inSig `SYB.extQ` inSigDecl) decl-     where-      inSigDecl :: GHC.LHsDecl GHC.RdrName -> [GHC.LSig GHC.RdrName]-      inSigDecl (GHC.L l (GHC.SigD s)) = inSig (GHC.L l s)-      inSigDecl _ = []--      inSig :: (GHC.LSig GHC.RdrName) -> [GHC.LSig GHC.RdrName]-      inSig (GHC.L l (GHC.TypeSig ns t p))-       | defines' ns /= [] = [(GHC.L l (GHC.TypeSig (defines' ns) t p))]-      inSig _ = []--      defines' :: [GHC.Located GHC.RdrName] -> [GHC.Located GHC.RdrName]-      defines' p-        -- = filter (\(GHC.L _ n) -> n `elem` pns) p-        = let-             isDefined :: GHC.Located GHC.RdrName -> [GHC.Located GHC.RdrName]-             isDefined ln = if (rdrName2NamePure nameMap ln) `elem` pns-                              then [ln]-                              else []-          in concatMap isDefined p---- ------------------------------------------------------------------------- |Find those declarations which define the specified GHC.Names.-definingTyClDeclsNames:: (SYB.Data t)-            => [GHC.Name]   -- ^ The specified identifiers.-            -> t -- ^ A collection of declarations.-            ->[GHC.LTyClDecl GHC.Name]  -- ^ The result.-definingTyClDeclsNames pns t = defining t-  where-   defining decl-     = SYB.everythingStaged SYB.Renamer (++) []-                   ([]  `SYB.mkQ` defines') decl-     where-      defines' :: (GHC.LTyClDecl GHC.Name) -> [GHC.LTyClDecl GHC.Name]-      defines' decl'@(GHC.L _ (GHC.FamDecl (GHC.FamilyDecl _ (GHC.L _ pname) _ _)))-        |isJust (find (==(pname)) pns) = [decl']-        | otherwise = []--      defines' decl'@(GHC.L _ (GHC.SynDecl (GHC.L _ pname) _ _ _))-        |isJust (find (==(pname)) pns) = [decl']-        | otherwise = []--      defines' decl'@(GHC.L _ (GHC.DataDecl (GHC.L _ pname) _ _ _))-        |isJust (find (==(pname)) pns) = [decl']-        | otherwise = []--      defines' decl'@(GHC.L _ (GHC.ClassDecl _ (GHC.L _ pname) _ _ _ _ _ _ _ _))-        |isJust (find (==(pname)) pns) = [decl']-        | otherwise = []---- ------------------------------------------------------------------------- | Return True if the function\/pattern binding defines the--- specified identifier.-defines:: GHC.Name -> GHC.LHsBind GHC.Name -> Bool-defines n (GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ _ _))- = GHC.nameUnique pname == GHC.nameUnique n-defines n (GHC.L _ (GHC.PatBind p _rhs _ty _fvs _))- = elem (GHC.nameUnique n) (map GHC.nameUnique $ hsNamess p)-defines _ _= False---- | Return True if the function\/pattern binding defines the--- specified identifier.-definesRdr :: NameMap -> GHC.Name -> GHC.LHsBind GHC.RdrName -> Bool-definesRdr nameMap nin (GHC.L _ (GHC.FunBind (GHC.L ln _pname) _ _ _ _ _)) =-  case Map.lookup ln nameMap of-    Nothing -> False-    Just n ->  GHC.nameUnique n == GHC.nameUnique nin-definesRdr nameMap n (GHC.L _ (GHC.PatBind p _rhs _ty _fvs _)) =-  elem n (map (rdrName2NamePure nameMap) (hsNamessRdr p))-definesRdr _ _ _= False---- |Unwraps a LHsDecl and calls definesRdr on the result if a HsBind-definesDeclRdr :: NameMap -> GHC.Name -> GHC.LHsDecl GHC.RdrName -> Bool-definesDeclRdr nameMap nin (GHC.L l (GHC.ValD d)) = definesRdr nameMap nin (GHC.L l d)-definesDeclRdr _ _ _ = False---definesP::PName -> HsDeclP ->Bool-definesP pn (GHC.L _ (GHC.ValD (GHC.FunBind (GHC.L _ pname) _ _ _ _ _)))- = PN pname == pn-definesP pn (GHC.L _ (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _)))- = elem pn (hsPNs p)-definesP _ _= False---- ------------------------------------------------------------------------- | Return True if the declaration defines the type signature of the--- specified identifier.-definesTypeSig :: GHC.Name -> GHC.LSig GHC.Name -> Bool-definesTypeSig pn (GHC.L _ (GHC.TypeSig names _typ _)) = elem (GHC.nameUnique pn) $ map (\(GHC.L _ n)->GHC.nameUnique n) names-definesTypeSig _  _ = False---- | Return True if the declaration defines the type signature of the--- specified identifier.-definesTypeSigRdr :: NameMap -> GHC.Name -> GHC.Sig GHC.RdrName -> Bool-definesTypeSigRdr nameMap pn (GHC.TypeSig names _typ _)-  = elem (GHC.nameUnique pn) (map (GHC.nameUnique . rdrName2NamePure nameMap) names)--- definesTypeSigRdr _ _  _ = False-definesTypeSigRdr _ _  x = error $ "definesTypeSigRdr : got " ++ SYB.showData SYB.Parser 0 x---- |Unwraps a LHsDecl and calls definesRdr on the result if a Sig-definesSigDRdr :: NameMap -> GHC.Name -> GHC.LHsDecl GHC.RdrName -> Bool-definesSigDRdr nameMap nin (GHC.L _ (GHC.SigD d)) = definesTypeSigRdr nameMap nin d-definesSigDRdr _ _ _ = False---- ------------------------------------------------------------------------- |Find all Located Names in the given Syntax phrase.-allNames::(SYB.Data t)-       =>t                      -- ^ The syntax phrase-       ->[GHC.Located GHC.Name] -- ^ The result-allNames t-  = res-       where-        res = SYB.everythingStaged SYB.Parser (++) []-            ([] `SYB.mkQ` worker `SYB.extQ` workerBind `SYB.extQ` workerExpr) t--        worker (pnt :: (GHC.Located GHC.Name))-          = [pnt]-        -- worker _ = []--        workerBind (GHC.L l (GHC.VarPat name) :: (GHC.Located (GHC.Pat GHC.Name)))-          = [(GHC.L l name)]-        workerBind _ = []--        workerExpr ((GHC.L l (GHC.HsVar name)) :: (GHC.Located (GHC.HsExpr GHC.Name)))-          = [(GHC.L l name)]-        workerExpr _ = []------ ------------------------------------------------------------------------- |Get all the names in the given syntax element-hsNamess :: (SYB.Data t) => t -> [GHC.Name]-hsNamess t = nub $ concat res-  where-     res = SYB.everythingStaged SYB.Renamer (++) [] ([] `SYB.mkQ` inName) t--     inName (pname :: GHC.Name) = return [pname]---- |Get all the names in the given syntax element-hsNamessRdr :: (SYB.Data t) => t -> [GHC.Located GHC.RdrName]-hsNamessRdr t = nub $ fromMaybe [] r-  where-     r = (SYB.everythingStaged SYB.Parser mappend mempty (inName) t)--     checker :: GHC.Located GHC.RdrName -> Maybe [GHC.Located GHC.RdrName]-     checker x = Just [x]--     inName :: (SYB.Typeable a) => a -> Maybe [GHC.Located GHC.RdrName]-     inName = nameSybQuery checker---- ------------------------------------------------------------------------getDeclaredVarsRdr :: NameMap -> [GHC.LHsDecl GHC.RdrName] -> [GHC.Name]-getDeclaredVarsRdr nm bs = concatMap vars bs-  where-      vars :: (GHC.LHsDecl GHC.RdrName) -> [GHC.Name]-      vars (GHC.L _ (GHC.ValD (GHC.FunBind ln _ _ _ _fvs _)))   = [rdrName2NamePure nm ln]-      vars (GHC.L _ (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) = (hsNamess p)-      vars _ = []--getDeclaredVars :: [GHC.LHsBind GHC.Name] -> [GHC.Name]-getDeclaredVars bs = concatMap vars bs-  where-      vars :: (GHC.LHsBind GHC.Name) -> [GHC.Name]-      vars (GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ _fvs _)) = [pname]-      vars (GHC.L _ (GHC.PatBind p _rhs _ty _fvs _))            = (hsNamess p)-      vars _ = []---- ------------------------------------------------------------------------ |Experiment with GHC fvs stuff-getFvs :: [GHC.LHsBind GHC.Name] -> [([GHC.Name], GHC.NameSet)]-getFvs bs = concatMap binds bs-  where-      binds :: (GHC.LHsBind GHC.Name) -> [([GHC.Name],GHC.NameSet)]-      binds (GHC.L _ (GHC.FunBind (GHC.L _ pname) _ _ _ fvs _)) = [([pname],     fvs)]-      binds (GHC.L _ (GHC.PatBind p _rhs _ty fvs _))            = [((hsNamess p),fvs)]-      binds _ = []--getFreeVars :: [GHC.LHsBind GHC.Name] -> [GHC.Name]-getFreeVars bs = concatMap binds bs-  where-      binds :: (GHC.LHsBind GHC.Name) -> [GHC.Name]-      binds (GHC.L _ (GHC.FunBind (GHC.L _ _pname) _ _ _ fvs _)) = (GHC.nameSetElems fvs)-      binds (GHC.L _ (GHC.PatBind _p _rhs _ty fvs _))            = (GHC.nameSetElems fvs)-      binds _ = []------------------------------------------------------------------------------ | Given syntax phrases e and t, if e occurs in t, then return those--- variables which are declared in t and accessible to e, otherwise--- return [].-hsVisiblePNs :: (FindEntity e,HsValBinds t GHC.Name,GHC.Outputable e)-             => e -> t -> RefactGhc [GHC.Name]-hsVisiblePNs e t = do-  (DN d) <- hsVisibleDs e t-  return d------------------------------------------------------------------------------------- | Same as `hsVisiblePNs' except that the returned identifiers are--- in String format.-hsVisibleNames:: (FindEntity t1,HsValBinds t2 GHC.Name,GHC.Outputable t1)-  => t1 -> t2 -> RefactGhc [String]-hsVisibleNames e t = do-    d <- hsVisiblePNs e t-    return ((nub . map showGhc) d)------------------------------------------------------------------------------------- | Same as `hsVisiblePNs' except that the returned identifiers are--- in String format.-hsVisibleNamesRdr:: (FindEntity t1,SYB.Data t2,GHC.Outputable t1)-  => t1 -> t2 -> RefactGhc [String]-hsVisibleNamesRdr e t = do-    nm <- getRefactNameMap-    d <- hsVisiblePNsRdr nm e t-    return ((nub . map showGhc) d)------------------------------------------------------------------------------ | Given syntax phrases e and t, if e occurs in t, then return those--- variables which are declared in t and accessible to e, otherwise--- return [].-hsVisiblePNsRdr :: (FindEntity e,SYB.Data t,GHC.Outputable e)-             => NameMap -> e -> t -> RefactGhc [GHC.Name]-hsVisiblePNsRdr nm e t = do-  (DN d) <- hsVisibleDsRdr nm e t-  return d------------------------------------------------------------------------------ | Given syntax phrases e and t, if e occurs in t, then return those--- variables which are declared in t and accessible to e, otherwise--- return [].-hsVisibleDsRdr :: (FindEntity e, GHC.Outputable e,SYB.Data t)-             => NameMap -> e -> t -> RefactGhc DeclaredNames-hsVisibleDsRdr nm e t = do-  -- logm $ "hsVisibleDsRdr:(e,t)=" ++ (SYB.showData SYB.Renamer 0 (e,t))-  (DN d) <- res-  return (DN (nub d))-  where-    -- TODO: this is effectively a recursive descent approach, where-    --       each syntax element processor knows exactly what it needs-    --       in terms of sub-elements. Hence as an optimisation,-    --       consider calling the relevent element directly, instead-    --       of looping back into the main function.-    res = (const err -- (DN [])-          `SYB.extQ` parsed-          `SYB.extQ` valbinds-          `SYB.extQ` lhsdecls-          `SYB.extQ` lhsdecl-          `SYB.extQ` lhsbindslr-          `SYB.extQ` hsbinds-          `SYB.extQ` hsbind-          `SYB.extQ` hslocalbinds-          `SYB.extQ` lmatch-          `SYB.extQ` grhss-          `SYB.extQ` lgrhs-          `SYB.extQ` lexpr-          `SYB.extQ` tyclgroups-          `SYB.extQ` tyclgroup-          `SYB.extQ` tycldeclss-          `SYB.extQ` tycldecls-          `SYB.extQ` tycldecl-          `SYB.extQ` instdecls-          `SYB.extQ` instdecl-          `SYB.extQ` lhstype-          `SYB.extQ` lsigs-          `SYB.extQ` lsig-          ) t--    -- err2 = error $ "hsVisibleDsRdr:err2:no match for:" ++ (SYB.showData SYB.Renamer 0 t)--    parsed :: GHC.ParsedSource -> RefactGhc DeclaredNames-    parsed p-      | findEntity e p = do-         -- dfds <- mapM (hsVisibleDsRdr nm e) $ GHC.hsmodDecls $ GHC.unLoc p-         logm $ "hsVisibleDsRdr parsedSource:decls starting"-         dfds <- mapM (declFun ( hsVisibleDsRdr nm e) ) $ GHC.hsmodDecls $ GHC.unLoc p-         logm $ "hsVisibleDsRdr parsedSource:decls done"-         return $ mconcat dfds-    parsed _ = return (DN [])--    valbinds :: (GHC.HsValBindsLR GHC.RdrName GHC.RdrName) -> RefactGhc DeclaredNames-    valbinds vb@(GHC.ValBindsIn bindsBag sigs)-      | findEntity e vb = do-          fdsb <- mapM (hsVisibleDsRdr nm e) $ hsBinds bindsBag-          fdss <- mapM (hsVisibleDsRdr nm e) sigs-          return $ mconcat fdss <> mconcat fdsb-    valbinds vb@(GHC.ValBindsOut _binds _sigs)-      | findEntity e vb = do-          logm $ "hsVisibleDsRdr valbinds:ValBindsOut:impossible for RdrName"-          return (DN [])--    valbinds _ = do-      logm $ "hsVisibleDsRdr nm.valbinds:not matched"-      return (DN [])--    lhsdecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc DeclaredNames-    lhsdecls ds-      | findEntity e ds = do-         dfds <- mapM (declFun ( hsVisibleDsRdr nm e) ) ds-         return $ mconcat dfds-    lhsdecls _ = return (DN [])--    lhsdecl :: GHC.LHsDecl GHC.RdrName -> RefactGhc DeclaredNames-    lhsdecl (GHC.L l dd) = do-        logm $ "hsVisibleDsRdr.lhsdecl"-        case dd of-            GHC.TyClD d       -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.InstD d       -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.DerivD d      -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.ValD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.SigD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.DefD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.ForD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.WarningD d    -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.AnnD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.RuleD d       -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.VectD d       -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.SpliceD d     -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.DocD d        -> hsVisibleDsRdr nm e (GHC.L l d)-            GHC.RoleAnnotD d  -> hsVisibleDsRdr nm e (GHC.L l d)-#if __GLASGOW_HASKELL__ < 711-            GHC.QuasiQuoteD d -> hsVisibleDsRdr nm e (GHC.L l d)-#endif--    lhsbindslr :: GHC.LHsBindsLR GHC.RdrName GHC.RdrName -> RefactGhc DeclaredNames-    lhsbindslr bs = do-      fds <- mapM (hsVisibleDsRdr nm e) $ GHC.bagToList bs-      return $ mconcat fds--    hsbinds :: [GHC.LHsBind GHC.RdrName] -> RefactGhc DeclaredNames-    hsbinds ds-      | findEntity e ds = do-        fds <- mapM (hsVisibleDsRdr nm e) ds-        return $ mconcat fds-    hsbinds _ = return (DN [])--    hsbind :: (GHC.LHsBind GHC.RdrName) -> RefactGhc DeclaredNames-    hsbind ((GHC.L _ (GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _)))-      | findEntity e matches = do-          fds <- mapM (hsVisibleDsRdr nm e) matches-          logm $ "hsVisibleDsRdr.hsbind:fds=" ++ show fds-          return $ mconcat fds-    hsbind _ = do-      logm $ "hsVisibleDsRdr.hsbind:miss"-      return (DN [])--    hslocalbinds :: (GHC.HsLocalBinds GHC.RdrName) -> RefactGhc DeclaredNames-    hslocalbinds (GHC.HsValBinds binds)-      | findEntity e binds = hsVisibleDsRdr nm e binds-    hslocalbinds (GHC.HsIPBinds binds)-      | findEntity e binds = hsVisibleDsRdr nm e binds-    hslocalbinds (GHC.EmptyLocalBinds) = return (DN [])-    hslocalbinds _ = return (DN [])--    lmatch :: (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> RefactGhc DeclaredNames-    lmatch (GHC.L _ (GHC.Match _fn pats _mtyp rhs))-      | findEntity e pats = do-           logm $ "hsVisibleDsRdr nm.lmatch:in pats="-           return (DN []) -- TODO: extend this-      | findEntity e rhs = do-           logm $ "hsVisibleDsRdr nm.lmatch:doing rhs"-           let (pf,pd) = hsFreeAndDeclaredRdr nm pats-           logm $ "hsVisibleDsRdr nm.lmatch:(pf,pd)=" ++ (show (pf,pd))-           (    rd) <- hsVisibleDsRdr nm e rhs-           return (pd <> rd)-    lmatch _ =return  (DN [])--    grhss :: (GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> RefactGhc DeclaredNames-    grhss (GHC.GRHSs guardedRhss lstmts)-      | findEntity e guardedRhss = do-          logm "hsVisibleDsRdr nm.grhss:about to do grhss"-          fds <- mapM (hsVisibleDsRdr nm e) guardedRhss-          logm "hsVisibleDsRdr nm.grhss:grhss done"-          return $ mconcat fds-      | findEntity e lstmts = do-          logm "hsVisibleDsRdr nm.grhss:about to do lstmts"-          hsVisibleDsRdr nm e lstmts-    grhss _ = return (DN [])--    lgrhs :: GHC.LGRHS GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc DeclaredNames-    lgrhs (GHC.L _ (GHC.GRHS guards ex))-      | findEntity e guards = logm "hsVisibleDsRdr nm.lgrhs.guards" >> hsVisibleDsRdr nm e guards-      | findEntity e ex     = logm "hsVisibleDsRdr nm.lgrhs.ex"     >> hsVisibleDsRdr nm e ex-    lgrhs _ = return (DN [])---    lexpr :: GHC.LHsExpr GHC.RdrName -> RefactGhc DeclaredNames-    lexpr (GHC.L l (GHC.HsVar n))-      | findEntity e n  = do-        logm $ "hsVisibleDsRdr.lexpr.HsVar entity found"-        return (DN [rdrName2NamePure nm (GHC.L l n)])-    lexpr (GHC.L _ (GHC.HsLet lbinds expr))-      | findEntity e lbinds || findEntity e expr  = do-        logm $ "hsVisibleDsRdr.lexpr.HsLet entity found"-        let (_,lds) = hsFreeAndDeclaredRdr nm lbinds-        let (_,eds) = hsFreeAndDeclaredRdr nm expr-        return $ lds <> eds--    lexpr expr-      | findEntity e expr = do-        logm $ "hsVisibleDsRdr nm.lexpr.(e,expr):" ++ (showGhc (e,expr))-        let (FN efs,_)         = hsFreeAndDeclaredRdr nm expr-        let (FN _eefs,DN eeds) = hsFreeAndDeclaredRdr nm e-        logm $ "hsVisibleDsRdr nm.lexpr done"-        -- return (DN e1fs <> DN eofs <> DN e2fs)-        return (DN (efs \\ eeds))--    lexpr x = do-      logm $ "hsVisibleDsRdr.lexpr:miss for:" ++ SYB.showData SYB.Parser 0 x-      return (DN [])--    -- -----------------------------------    tyclgroups :: [GHC.TyClGroup GHC.RdrName] -> RefactGhc DeclaredNames-    tyclgroups tgrps-      | findEntity e tgrps = do-        fds <- mapM (hsVisibleDsRdr nm e) tgrps-        return $ mconcat fds-    tyclgroups _ = return (DN [])--    tyclgroup :: GHC.TyClGroup GHC.RdrName -> RefactGhc DeclaredNames-    tyclgroup (GHC.TyClGroup tyclds _roles)-      | findEntity e tyclds = do-        fds <- mapM (hsVisibleDsRdr nm e) tyclds-        return $ mconcat fds-    tyclgroup _ = return (DN [])--    tycldeclss :: [[GHC.LTyClDecl GHC.RdrName]] -> RefactGhc DeclaredNames-    tycldeclss tcds-      | findEntity e tcds = do-        fds <- mapM (hsVisibleDsRdr nm e) tcds-        return $ mconcat fds-    tycldeclss _ = return (DN [])--    tycldecls :: [GHC.LTyClDecl GHC.RdrName] -> RefactGhc DeclaredNames-    tycldecls tcds-      | findEntity e tcds = do-        logm $ "hsVisibleDsRdr.tycldecls"-        fds <- mapM (hsVisibleDsRdr nm e) tcds-        logm $ "hsVisibleDsRdr.tycldecls done"-        return $ mconcat fds-    tycldecls _ = return (DN [])--    tycldecl :: GHC.LTyClDecl GHC.RdrName -> RefactGhc DeclaredNames-    tycldecl tcd-      | findEntity e tcd = do-        logm $ "hsVisibleDsRdr.tycldecl"-        let (_,ds) = hsFreeAndDeclaredRdr nm tcd-        logm $ "hsVisibleDsRdr.tycldecl done"-        return ds-    tycldecl _ = return (DN [])--    -- -----------------------------------    instdecls :: [GHC.LInstDecl GHC.RdrName] -> RefactGhc DeclaredNames-    instdecls ds-      | findEntity e ds = do-        fds <- mapM (hsVisibleDsRdr nm e) ds-        return $ mconcat fds-    instdecls _ = return (DN [])--    instdecl :: GHC.LInstDecl GHC.RdrName -> RefactGhc DeclaredNames-    instdecl (GHC.L _ (GHC.ClsInstD (GHC.ClsInstDecl polytyp binds sigs tyfaminsts dfaminsts _)))-      | findEntity e polytyp    = hsVisibleDsRdr nm e polytyp-      | findEntity e binds      = hsVisibleDsRdr nm e binds-      | findEntity e sigs       = hsVisibleDsRdr nm e sigs-      | findEntity e tyfaminsts = hsVisibleDsRdr nm e tyfaminsts-      | findEntity e dfaminsts  = hsVisibleDsRdr nm e dfaminsts-      | otherwise = return (DN [])-    instdecl (GHC.L _ (GHC.DataFamInstD (GHC.DataFamInstDecl _ln pats defn _)))-      | findEntity e pats = hsVisibleDsRdr nm e pats-      | findEntity e defn = hsVisibleDsRdr nm e defn-      | otherwise = return (DN [])-    instdecl (GHC.L _ (GHC.TyFamInstD (GHC.TyFamInstDecl eqn _)))-      | findEntity e eqn = hsVisibleDsRdr nm e eqn-      | otherwise = return (DN [])--    lhstype :: GHC.LHsType GHC.RdrName -> RefactGhc DeclaredNames-    lhstype tv@(GHC.L l (GHC.HsTyVar n))-      | findEntity e tv = return (DN [rdrName2NamePure nm (GHC.L l n)])-      | otherwise       = return (DN [])-    lhstype (GHC.L _ (GHC.HsForAllTy _ _ _bndrs _ctxt _typ))-        = return (DN [])-    lhstype (GHC.L _ (GHC.HsFunTy{})) = return (DN [])-    lhstype ty = do-      logm $ "lshtype: TypeUtils 1588" ++ SYB.showData SYB.Renamer 0 ty-      return (DN [])--    -- -------------------------    lsigs :: [GHC.LSig GHC.RdrName] -> RefactGhc DeclaredNames-    lsigs ss = do-      fds <- mapM (hsVisibleDsRdr nm e) ss-      return $ mconcat fds--    -- -------------------------    lsig :: GHC.LSig GHC.RdrName -> RefactGhc DeclaredNames-    lsig (GHC.L _ (GHC.TypeSig _ns typ _))-      | findEntity e typ = hsVisibleDsRdr nm e typ-    lsig (GHC.L _ (GHC.GenericSig _n typ))-      | findEntity e typ = hsVisibleDsRdr nm e typ-    lsig (GHC.L _ (GHC.IdSig _)) = return (DN [])-    lsig (GHC.L _ (GHC.InlineSig _ _)) = return (DN [])-    lsig (GHC.L _ (GHC.SpecSig _n typ _))-      | findEntity e typ = hsVisibleDsRdr nm e typ-    lsig (GHC.L _ (GHC.SpecInstSig _ _)) = return (DN [])--    lsig _ = return (DN [])--    -- -------------------------    err = error $ "hsVisibleDsRdr nm:no match for:" ++ (SYB.showData SYB.Renamer 0 t)------------------------------------------------------------------------------- | Given syntax phrases e and t, if e occurs in t, then return those--- variables which are declared in t and accessible to e, otherwise--- return [].-hsVisibleDs :: (FindEntity e, GHC.Outputable e-               ,SYB.Data t,HsValBinds t GHC.Name)-             => e -> t -> RefactGhc DeclaredNames-hsVisibleDs e t = do-  -- logm $ "hsVisibleDs:(e,t)=" ++ (SYB.showData SYB.Renamer 0 (e,t))-  (DN d) <- res-  return (DN (nub d))-  where-    -- TODO: this is effectively a recursive descent approach, where-    --       each syntax element processor knows exactly what it needs-    --       in terms of sub-elements. Hence as an optimisation,-    --       consider calling the relevent element directly, instead-    --       of looping back into the main function.-    res = (const err -- (DN [])-          `SYB.extQ` renamed-          `SYB.extQ` valbinds-          `SYB.extQ` lhsbindslr-          `SYB.extQ` hsbinds-          `SYB.extQ` hsbind-          `SYB.extQ` hslocalbinds-          `SYB.extQ` lmatch-          `SYB.extQ` grhss-          `SYB.extQ` lgrhs-          `SYB.extQ` lexpr-          `SYB.extQ` tyclgroups-          `SYB.extQ` tyclgroup-          `SYB.extQ` tycldeclss-          `SYB.extQ` tycldecls-          `SYB.extQ` tycldecl-          `SYB.extQ` instdecls-          `SYB.extQ` instdecl-          `SYB.extQ` lhstype-          `SYB.extQ` lsigs-          `SYB.extQ` lsig-          ) t--    renamed :: GHC.RenamedSource -> RefactGhc DeclaredNames-    renamed (g,_i,_ex,_d)-      | findEntity e g = do-         dfds <- hsVisibleDs e $ GHC.hs_valds g-         -- logm $ "hsVisibleDs.renamedSource:valds done"-         tfds <- hsVisibleDs e $ GHC.hs_tyclds g-         -- logm $ "hsVisibleDs.renamedSource:tyclds done"-         ifds <- hsVisibleDs e $ GHC.hs_instds g-         -- logm $ "hsVisibleDs.renamedSource:instds done"-         return $ dfds <> tfds <> ifds-    renamed _ = return (DN [])--    valbinds :: (GHC.HsValBindsLR GHC.Name GHC.Name) -> RefactGhc DeclaredNames-    valbinds vb@(GHC.ValBindsIn bindsBag sigs)-      | findEntity e vb = do-          fdsb <- mapM (hsVisibleDs e) $ hsBinds bindsBag-          fdss <- mapM (hsVisibleDs e) sigs-          return $ mconcat fdss <> mconcat fdsb-    valbinds vb@(GHC.ValBindsOut binds sigs)-      | findEntity e vb = do-          -- logm $ "hsVisibleDs.valbinds:ValBindsOut"-          fdsb <- mapM (hsVisibleDs e) $ map snd binds-          fdss <- mapM (hsVisibleDs e) sigs-          return $ mconcat fdss <> mconcat fdsb--    valbinds _ = do-      -- logm $ "hsVisibleDs.valbinds:not matched"-      return (DN [])--    lhsbindslr :: GHC.LHsBindsLR GHC.Name GHC.Name -> RefactGhc DeclaredNames-    lhsbindslr bs = do-      fds <- mapM (hsVisibleDs e) $ GHC.bagToList bs-      return $ mconcat fds--    hsbinds :: [GHC.LHsBind GHC.Name] -> RefactGhc DeclaredNames-    hsbinds ds-      | findEntity e ds = do-        fds <- mapM (hsVisibleDs e) ds-        return $ mconcat fds-    hsbinds _ = return (DN [])--    hsbind :: (GHC.LHsBind GHC.Name) -> RefactGhc DeclaredNames-    hsbind ((GHC.L _ (GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _)))-      | findEntity e matches = do-          fds <- mapM (hsVisibleDs e) matches-          -- logm $ "hsVisibleDs.hsbind:fds=" ++ show fds-          return $ mconcat fds-    hsbind _ = return (DN [])--    hslocalbinds :: (GHC.HsLocalBinds GHC.Name) -> RefactGhc DeclaredNames-    hslocalbinds (GHC.HsValBinds binds)-      | findEntity e binds = hsVisibleDs e binds-    hslocalbinds (GHC.HsIPBinds binds)-      | findEntity e binds = hsVisibleDs e binds-    hslocalbinds (GHC.EmptyLocalBinds) = return (DN [])-    hslocalbinds _ = return (DN [])--    lmatch :: (GHC.LMatch GHC.Name (GHC.LHsExpr GHC.Name)) -> RefactGhc DeclaredNames-    lmatch (GHC.L _ (GHC.Match _fn pats _mtyp rhs))-      | findEntity e pats = do-           -- logm $ "hsVisibleDs.lmatch:in pats="-           return (DN []) -- TODO: extend this-      | findEntity e rhs = do-           -- logm $ "hsVisibleDs.lmatch:doing rhs"-           (_pf,pd) <- hsFreeAndDeclaredGhc pats-           -- logm $ "hsVisibleDs.lmatch:(pf,pd)=" ++ (show (pf,pd))-           (    rd) <- hsVisibleDs e rhs-           return (pd <> rd)-    lmatch _ =return  (DN [])--    grhss :: (GHC.GRHSs GHC.Name (GHC.LHsExpr GHC.Name)) -> RefactGhc DeclaredNames-    grhss (GHC.GRHSs guardedRhss lstmts)-      | findEntity e guardedRhss = do-          -- logm "hsVisibleDs.grhss:about to do grhss"-          fds <- mapM (hsVisibleDs e) guardedRhss-          -- logm "hsVisibleDs.grhss:grhss done"-          return $ mconcat fds-      | findEntity e lstmts = do-          -- logm "hsVisibleDs.grhss:about to do lstmts"-          hsVisibleDs e lstmts-    grhss _ = return (DN [])--    lgrhs :: GHC.LGRHS GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc DeclaredNames-    lgrhs (GHC.L _ (GHC.GRHS guards ex))-      | findEntity e guards = hsVisibleDs e guards-      | findEntity e ex     = hsVisibleDs e ex-    lgrhs _ = return (DN [])---    lexpr :: GHC.LHsExpr GHC.Name -> RefactGhc DeclaredNames-    lexpr (GHC.L _ (GHC.HsVar n))-      | findEntity e n  = return (DN [n])-    lexpr (GHC.L _ (GHC.HsLet lbinds expr))-      | findEntity e lbinds || findEntity e expr  = do-        (_,lds) <- hsFreeAndDeclaredGhc lbinds-        (_,eds) <- hsFreeAndDeclaredGhc expr-        return $ lds <> eds--    lexpr expr-      | findEntity e expr = do-        -- logm $ "hsVisibleDs.lexpr.(e,expr):" ++ (showGhc (e,expr))-        (FN efs,_)         <- hsFreeAndDeclaredGhc expr-        (FN _eefs,DN eeds) <- hsFreeAndDeclaredGhc e-        -- logm $ "hsVisibleDs.lexpr done"-        -- return (DN e1fs <> DN eofs <> DN e2fs)-        return (DN (efs \\ eeds))--    lexpr _ = return (DN [])--    -- -----------------------------------    tyclgroups :: [GHC.TyClGroup GHC.Name] -> RefactGhc DeclaredNames-    tyclgroups tgrps-      | findEntity e tgrps = do-        fds <- mapM (hsVisibleDs e) tgrps-        return $ mconcat fds-    tyclgroups _ = return (DN [])--    tyclgroup :: GHC.TyClGroup GHC.Name -> RefactGhc DeclaredNames-    tyclgroup (GHC.TyClGroup tyclds _roles)-      | findEntity e tyclds = do-        fds <- mapM (hsVisibleDs e) tyclds-        return $ mconcat fds-    tyclgroup _ = return (DN [])--    tycldeclss :: [[GHC.LTyClDecl GHC.Name]] -> RefactGhc DeclaredNames-    tycldeclss tcds-      | findEntity e tcds = do-        fds <- mapM (hsVisibleDs e) tcds-        return $ mconcat fds-    tycldeclss _ = return (DN [])--    tycldecls :: [GHC.LTyClDecl GHC.Name] -> RefactGhc DeclaredNames-    tycldecls tcds-      | findEntity e tcds = do-        -- logm $ "hsVisibleDs.tycldecls"-        fds <- mapM (hsVisibleDs e) tcds-        return $ mconcat fds-    tycldecls _ = return (DN [])--    tycldecl :: GHC.LTyClDecl GHC.Name -> RefactGhc DeclaredNames-    tycldecl tcd-      | findEntity e tcd = do-        -- logm $ "hsVisibleDs.tycldecl"-        (_,ds) <- hsFreeAndDeclaredGhc tcd-        return ds-    tycldecl _ = return (DN [])--    -- -----------------------------------    instdecls :: [GHC.LInstDecl GHC.Name] -> RefactGhc DeclaredNames-    instdecls ds-      | findEntity e ds = do-        fds <- mapM (hsVisibleDs e) ds-        return $ mconcat fds-    instdecls _ = return (DN [])--    instdecl :: GHC.LInstDecl GHC.Name -> RefactGhc DeclaredNames-    instdecl (GHC.L _ (GHC.ClsInstD (GHC.ClsInstDecl polytyp binds sigs tyfaminsts dfaminsts _)))-      | findEntity e polytyp    = hsVisibleDs e polytyp-      | findEntity e binds      = hsVisibleDs e binds-      | findEntity e sigs       = hsVisibleDs e sigs-      | findEntity e tyfaminsts = hsVisibleDs e tyfaminsts-      | findEntity e dfaminsts  = hsVisibleDs e dfaminsts-      | otherwise = return (DN [])-    instdecl (GHC.L _ (GHC.DataFamInstD (GHC.DataFamInstDecl _ln pats defn _)))-      | findEntity e pats = hsVisibleDs e pats-      | findEntity e defn = hsVisibleDs e defn-      | otherwise = return (DN [])-    instdecl (GHC.L _ (GHC.TyFamInstD (GHC.TyFamInstDecl eqn _)))-      | findEntity e eqn = hsVisibleDs e eqn-      | otherwise = return (DN [])--    lhstype :: GHC.LHsType GHC.Name -> RefactGhc DeclaredNames-    lhstype tv@(GHC.L _ (GHC.HsTyVar n))-      | findEntity e tv = return (DN [n])-      | otherwise       = return (DN [])-    lhstype (GHC.L _ (GHC.HsForAllTy _ _ _bndrs _ctxt _typ))-        = return (DN [])-    lhstype (GHC.L _ (GHC.HsFunTy{})) = return (DN [])-    lhstype _ty = do-      -- logm $ "lshtype: TypeUtils 1588" ++ SYB.showData SYB.Renamer 0 _ty-      return (DN [])--    -- -------------------------    lsigs :: [GHC.LSig GHC.Name] -> RefactGhc DeclaredNames-    lsigs ss = do-      fds <- mapM (hsVisibleDs e) ss-      return $ mconcat fds--    -- -------------------------    lsig :: GHC.LSig GHC.Name -> RefactGhc DeclaredNames-    lsig (GHC.L _ (GHC.TypeSig _ns typ _))-      | findEntity e typ = hsVisibleDs e typ-    lsig (GHC.L _ (GHC.GenericSig _n typ))-      | findEntity e typ = hsVisibleDs e typ-    lsig (GHC.L _ (GHC.IdSig _)) = return (DN [])-    lsig (GHC.L _ (GHC.InlineSig _ _)) = return (DN [])-    lsig (GHC.L _ (GHC.SpecSig _n typ _))-      | findEntity e typ = hsVisibleDs e typ-    lsig (GHC.L _ (GHC.SpecInstSig _ _)) = return (DN [])--    lsig _ = return (DN [])--    -- -------------------------    err = error $ "hsVisibleDs:no match for:" ++ (SYB.showData SYB.Renamer 0 t)---- ------------------------------------------------------------------------- |`hsFDsFromInsideRdr` is different from `hsFreeAndDeclaredPNs` in--- that: given an syntax phrase t, `hsFDsFromInsideRdr` returns not only--- the declared variables that are visible from outside of t, but also--- those declared variables that are visible to the main expression--- inside t.--- NOTE: Expects to be given RenamedSource-hsFDsFromInsideRdr:: (SYB.Data t)-                  => NameMap ->  t -> RefactGhc (FreeNames,DeclaredNames)-hsFDsFromInsideRdr nm t = do-   r <- hsFDsFromInsideRdr' t-   return r-   where-     hsFDsFromInsideRdr' :: (SYB.Data t) => t -> RefactGhc (FreeNames,DeclaredNames)-     hsFDsFromInsideRdr' t1 = do-          r1 <- applyTU (once_tdTU (failTU  `adhocTU` parsed-                                            `adhocTU` decl-                                            `adhocTU` match-                                            `adhocTU` expr-                                            `adhocTU` stmts )) t1-          -- let (f',d') = fromMaybe ([],[]) r1-          let (FN f',DN d') = r1-          return (FN $ nub f', DN $ nub d')--     parsed :: GHC.ParsedSource -> RefactGhc (FreeNames,DeclaredNames)-     parsed p-        = return $ hsFreeAndDeclaredRdr nm p--     match :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (FreeNames,DeclaredNames)-     match (GHC.Match _fn pats _type rhs) = do-       let (FN pf, DN pd) = hsFreeAndDeclaredRdr nm pats-       let (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs-       return (FN $ nub (pf `union` (rf \\ pd)),-               DN $ nub (pd `union` rd))--     -- ------------------------     decl :: GHC.HsBind GHC.RdrName -> RefactGhc (FreeNames,DeclaredNames)-     decl (GHC.FunBind (GHC.L _ _) _ (GHC.MG matches _ _ _) _ _ _) =-       do-         fds <- mapM hsFDsFromInsideRdr' matches-         -- error (show $ nameToString n)-         return (FN $ nub (concat $ map (fn . fst) fds), DN $ nub (concat $ map (dn . snd) fds))--     decl ((GHC.PatBind p rhs _ _ _) :: GHC.HsBind GHC.RdrName) =-       do-         let (FN pf, DN pd) = hsFreeAndDeclaredRdr nm p-         let (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs-         return-           (FN $ nub (pf `union` (rf \\ pd)),-            DN $ nub (pd `union` rd))--     decl ((GHC.VarBind p rhs _) :: GHC.HsBind GHC.RdrName) =-       do-         let (FN pf, DN pd) = hsFreeAndDeclaredRdr nm p-         let (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs-         return-           (FN $ nub (pf `union` (rf \\ pd)),-            DN $ nub (pd `union` rd))--     decl _ = return (FN [],DN [])--     -- ------------------------     expr ((GHC.HsLet decls e) :: GHC.HsExpr GHC.RdrName) =-       do-         let (FN df,DN dd) = hsFreeAndDeclaredRdr nm decls-         let (FN ef,_)     = hsFreeAndDeclaredRdr nm e-         return (FN $ nub (df `union` (ef \\ dd)), DN $ nub dd)--     expr ((GHC.HsLam (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.RdrName) =-       return $ hsFreeAndDeclaredRdr nm matches--     expr ((GHC.HsCase e (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.RdrName) =-       do-         let (FN ef,_)     = hsFreeAndDeclaredRdr nm e-         let (FN df,DN dd) = hsFreeAndDeclaredRdr nm matches-         return (FN $ nub (df `union` (ef \\ dd)), DN $ nub dd)--     expr _ = mzero--     stmts ((GHC.BindStmt pat e1 e2 e3) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =-       do-         let (FN pf,DN pd)  = hsFreeAndDeclaredRdr nm pat-         let (FN ef,DN _ed) = hsFreeAndDeclaredRdr nm e1-         let (FN df,DN dd)  = hsFreeAndDeclaredRdr nm [e2,e3]-         return-           (FN $ nub (pf `union` (((ef \\ dd) `union` df) \\ pd)), DN $ nub (pd `union` dd))--     stmts ((GHC.LetStmt binds) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =-       return $ hsFreeAndDeclaredRdr nm binds--     stmts _ = mzero----- ------------------------------------------------------------------------- |`hsFDsFromInside` is different from `hsFreeAndDeclaredPNs` in--- that: given an syntax phrase t, `hsFDsFromInside` returns not only--- the declared variables that are visible from outside of t, but also--- those declared variables that are visible to the main expression--- inside t.--- NOTE: Expects to be given RenamedSource-hsFDsFromInside:: (SYB.Data t) => t-> RefactGhc ([GHC.Name],[GHC.Name])-hsFDsFromInside t = do-   r <- hsFDsFromInside' t-   return r-   where-     hsFDsFromInside' :: (SYB.Data t) => t -> RefactGhc ([GHC.Name],[GHC.Name])-     hsFDsFromInside' t1 = do-          r1 <- applyTU (once_tdTU (failTU  `adhocTU` renamed-                                            `adhocTU` decl-                                            `adhocTU` match-                                            `adhocTU` expr-                                            `adhocTU` stmts )) t1-          let (f',d') = r1-          return (nub f', nub d')--     renamed :: GHC.RenamedSource -> RefactGhc ([GHC.Name],[GHC.Name])-     renamed ((grp,_,_,_)::GHC.RenamedSource)-        = hsFreeAndDeclaredPNs $ GHC.hs_valds grp--     match :: GHC.Match GHC.Name (GHC.LHsExpr GHC.Name) -> RefactGhc ([GHC.Name],[GHC.Name])-     match ((GHC.Match _fn pats _type rhs):: GHC.Match GHC.Name (GHC.LHsExpr GHC.Name)) = do-       (pf, pd) <- hsFreeAndDeclaredPNs pats-       (rf, rd) <- hsFreeAndDeclaredPNs rhs-       return (nub (pf `union` (rf \\ pd)),-               nub (pd `union` rd))--     -- ------------------------     decl :: GHC.HsBind GHC.Name -> RefactGhc ([GHC.Name],[GHC.Name])-     decl ((GHC.FunBind (GHC.L _ _) _ (GHC.MG matches _ _ _) _ _ _) :: GHC.HsBind GHC.Name) =-       do-         fds <- mapM hsFDsFromInside' matches-         -- error (show $ nameToString n)-         return (nub (concatMap fst fds), nub (concatMap snd fds))--     decl ((GHC.PatBind p rhs _ _ _) :: GHC.HsBind GHC.Name) =-       do-         (pf, pd) <- hsFreeAndDeclaredPNs p-         (rf, rd) <- hsFreeAndDeclaredPNs rhs-         return-           (nub (pf `union` (rf \\ pd)),-            nub (pd `union` rd))--     decl ((GHC.VarBind p rhs _) :: GHC.HsBind GHC.Name) =-       do-         (pf, pd) <- hsFreeAndDeclaredPNs p-         (rf, rd) <- hsFreeAndDeclaredPNs rhs-         return-           (nub (pf `union` (rf \\ pd)),-            nub (pd `union` rd))--     decl _ = return ([],[])--     -- ------------------------     expr ((GHC.HsLet decls e) :: GHC.HsExpr GHC.Name) =-       do-         (df,dd) <- hsFreeAndDeclaredPNs decls-         (ef,_)  <- hsFreeAndDeclaredPNs e-         return (nub (df `union` (ef \\ dd)), nub dd)--     expr ((GHC.HsLam (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.Name) =-       hsFreeAndDeclaredPNs matches--     expr ((GHC.HsCase e (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.Name) =-       do-         (ef,_)  <- hsFreeAndDeclaredPNs e-         (df,dd) <- hsFreeAndDeclaredPNs matches-         return (nub (df `union` (ef \\ dd)), nub dd)--     expr _ = mzero--     stmts ((GHC.BindStmt pat e1 e2 e3) :: GHC.Stmt GHC.Name (GHC.LHsExpr GHC.Name)) =-       do-         (pf,pd)  <- hsFreeAndDeclaredPNs pat-         (ef,_ed) <- hsFreeAndDeclaredPNs e1-         (df,dd)  <- hsFreeAndDeclaredPNs [e2,e3]-         return-           (nub (pf `union` (((ef \\ dd) `union` df) \\ pd)), nub (pd `union` dd))--     stmts ((GHC.LetStmt binds) :: GHC.Stmt GHC.Name (GHC.LHsExpr GHC.Name)) =-       hsFreeAndDeclaredPNs binds--     stmts _ = mzero------ | The same as `hsFDsFromInside` except that the returned variables--- are in the String format-hsFDNamesFromInside::(SYB.Data t) => t -> RefactGhc ([String],[String])-hsFDNamesFromInside t = do-  (f,d) <- hsFDsFromInside t-  return-    ((nub.map showGhc) f, (nub.map showGhc) d)---- | The same as `hsFDsFromInside` except that the returned variables--- are in the String format-hsFDNamesFromInsideRdr ::(SYB.Data t) => t -> RefactGhc ([String],[String])-hsFDNamesFromInsideRdr t = do-  nm <- getRefactNameMap-  (FN f,DN d) <- hsFDsFromInsideRdr nm t-  return-    ((nub.map showGhc) f, (nub.map showGhc) d)---- -----------------------------------------------------------------------rdrName2Name' :: GHC.Located GHC.RdrName -> RefactGhc GHC.Name-rdrName2Name' (GHC.L l rdr) = do-  renamed <- getRefactRenamed-  let mn = locToName (getGhcLoc l) renamed-  return (GHC.unLoc $ gfromJust ("rdrName2Name':failed for:" ++ showGhc (GHC.L l rdr)) mn)---- -----------------------------------------------------------------------rdrName2Name :: GHC.Located GHC.RdrName -> RefactGhc GHC.Name-rdrName2Name ln = do-  nameMap <- getRefactNameMap-  return (rdrName2NamePure nameMap ln)--rdrName2NamePure :: NameMap -> GHC.Located GHC.RdrName -> GHC.Name-rdrName2NamePure _nameMap (GHC.L _ (GHC.Exact n)) = n-rdrName2NamePure nameMap (GHC.L lrn _) =-  fromMaybe (error $ "rdrName2NamePure: no name found for" ++ showGhc lrn)-  -- fromMaybe (error $ "rdrName2NamePure: no name found for (lrn,e,nameMap)=" ++ showGhc (lrn,e,nameMap))-             (Map.lookup lrn nameMap)--eqRdrNamePure :: NameMap -> GHC.Located GHC.RdrName -> GHC.Name -> Bool-eqRdrNamePure nameMap rn n-  = GHC.nameUnique (rdrName2NamePure nameMap rn) == GHC.nameUnique n---- ------------------------------------------------------------------------- |Find the identifier(in GHC.Name format) whose start position is--- (row,col) in the file specified by the fileName, and returns--- `Nothing` if such an identifier does not exist.-locToName::(SYB.Data t)-                    =>SimpPos          -- ^ The row and column number-                    ->t                -- ^ The syntax phrase-                    -> Maybe (GHC.Located GHC.Name)  -- ^ The result-locToName (row,col) t = locToName' (row,col) t---- |Find the identifier(in GHC.RdrName format) whose start position is--- (row,col) in the file specified by the fileName, and returns--- `Nothing` if such an identifier does not exist.-locToRdrName::(SYB.Data t)-                    =>SimpPos          -- ^ The row and column number-                    ->t                -- ^ The syntax phrase-                    -> Maybe (GHC.Located GHC.RdrName)  -- ^ The result-locToRdrName (row,col) t = locToName' (row,col) t----- |Worker for both locToName and locToRdrName.--- NOTE: provides for FunBind MatchGroups where only the first name is--- retained in the AST--locToName':: forall a t.(SYB.Data t, SYB.Data a, Eq a)-                    =>SimpPos          -- ^ The row and column number-                    ->t                -- ^ The syntax phrase-                    -> Maybe (GHC.Located a)  -- ^ The result-locToName' (row,col) t = res1-     where-        res1 :: Maybe (GHC.Located a)-        res1 = SYB.something (nameSybQuery checker) t--        checker pnt =+  , isDeclaredInRdr+  , FreeNames(..),DeclaredNames(..)+  , hsFreeAndDeclaredRdr+  , hsFreeAndDeclaredNameStrings+  , hsFreeAndDeclaredPNs+  -- , hsFreeAndDeclaredGhc+  , getDeclaredTypesRdr+  , getDeclaredVarsRdr+  , hsVisibleNamesRdr+  , hsFDsFromInsideRdr, hsFDNamesFromInsideRdr, hsFDNamesFromInsideRdrPure+  , hsVisibleDsRdr+  , rdrName2Name, rdrName2NamePure+  , eqRdrNamePure+  -- , rdrName2Name'++  -- ** Identifiers, expressions, patterns and declarations+  , FindEntity(..)+  , findNameInRdr+  , findNamesRdr+  , sameOccurrence+  , definedPNsRdr,definedNamesRdr+  , definingDeclsRdrNames,definingDeclsRdrNames',definingSigsRdrNames+  , definingTyClDeclsNames+  , definesRdr,definesDeclRdr+  , definesTypeSigRdr,definesSigDRdr++  , hsTypeVbls+  , hsNamessRdr+  , findLRdrName+  , locToNameRdr, locToNameRdrPure+  , locToRdrName+  ) where++import Control.Monad.State+import Data.List+import Data.Maybe+import Data.Monoid+-- import Debug.Trace++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.Types++import Language.Haskell.GHC.ExactPrint.Types+import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Utils+++-- Modules from GHC+import qualified Bag           as GHC+import qualified GHC           as GHC+import qualified Name          as GHC+import qualified Outputable    as GHC+import qualified RdrName       as GHC++import qualified Data.Generics as SYB+import qualified GHC.SYB.Utils as SYB++import qualified Data.Map as Map++import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero)++-- ---------------------------------------------------------------------++class (SYB.Data a, SYB.Typeable a) => FindEntity a where++  -- | Returns True is a syntax phrase, say a, is part of another+  -- syntax phrase, say b.+  -- NOTE: very important: only do a shallow check+  findEntity:: (SYB.Data b) => a -> b -> Bool++-- ---------------------------------------------------------------------++{-# DEPRECATED FindEntity "Can't use Renamed in GHC 8" #-}+instance FindEntity GHC.Name where++  findEntity n t = fromMaybe False res+   where+    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t++    worker (name::GHC.Name)+      | n == name = Just True+    worker _ = Nothing+++-- This instance does not make sense, it will only find the specific RdrName+-- where it was found, not any other instances of it.+instance FindEntity (GHC.Located GHC.RdrName) where++  findEntity ln t =+    case SYB.something (nameSybQuery checkRdr) t of+      Nothing -> False+      _       -> True+    where+      checkRdr :: GHC.Located GHC.RdrName -> Maybe Bool+      checkRdr n+        | sameOccurrence n ln = Just True+        | otherwise = Nothing++-- ---------------------------------------------------------------------++-- TODO: should the location be matched too in this case?+instance FindEntity (GHC.Located GHC.Name) where++  findEntity n t = fromMaybe False res+   where+    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t++    worker (name::GHC.Located GHC.Name)+      | n == name = Just True+    worker _ = Nothing+++-- ---------------------------------------------------------------------++instance FindEntity (GHC.LHsExpr GHC.RdrName) where++  findEntity e t = fromMaybe False res+   where+    res = SYB.something (Nothing `SYB.mkQ` worker) t++    worker (expr :: GHC.LHsExpr GHC.RdrName)+      | sameOccurrence e expr = Just True+    worker _ = Nothing++-- TODO: remove this instance+instance FindEntity (GHC.LHsExpr GHC.Name) where++  findEntity e t = fromMaybe False res+   where+    res = SYB.something (Nothing `SYB.mkQ` worker) t++    worker (expr :: GHC.LHsExpr GHC.Name)+      | sameOccurrence e expr = Just True+    worker _ = Nothing++-- ---------------------------------------------------------------------++instance FindEntity (GHC.Located (GHC.HsBindLR GHC.Name GHC.Name)) where+  findEntity e t = fromMaybe False res+   where+    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t++    worker (expr::(GHC.Located (GHC.HsBindLR GHC.Name GHC.Name)))+      | sameOccurrence e expr = Just True+    worker _ = Nothing++instance FindEntity (GHC.Located (GHC.HsDecl GHC.Name)) where+  findEntity d t = fromMaybe False res+   where+    res = SYB.somethingStaged SYB.Renamer Nothing (Nothing `SYB.mkQ` worker) t++    worker (decl::(GHC.Located (GHC.HsDecl GHC.Name)))+      | sameOccurrence d decl = Just True+    worker _ = Nothing++-- ---------------------------------------------------------------------++-- TODO: AZ: pretty sure this can be simplified, depends if we need to+--          manage transformed stuff too though.++-- | Return True if syntax phrases t1 and t2 refer to the same one.+sameOccurrence :: (GHC.Located t) -> (GHC.Located t) -> Bool+sameOccurrence (GHC.L l1 _) (GHC.L l2 _)+ = l1 == l2+++-- ---------------------------------------------------------------------++-- | For free variables+data FreeNames = FN { fn :: [GHC.Name] }++-- | For declared variables+data DeclaredNames = DN { dn :: [GHC.Name] }++instance Show FreeNames where+  show (FN ls) = "FN " ++ showGhcQual ls++instance Show DeclaredNames where+  show (DN ls) = "DN " ++ showGhcQual ls++instance Monoid FreeNames where+  mempty = FN []+  mappend (FN a) (FN b) = FN (a `mappend` b)++instance Monoid DeclaredNames where+  mempty = DN []+  mappend (DN a) (DN b) = DN (a `mappend` b)+++emptyFD :: (FreeNames,DeclaredNames)+emptyFD = (FN [], DN [])++-- ---------------------------------------------------------------------+-- | True if the name is a field name+isFieldName :: GHC.Name -> Bool+isFieldName _n = error "undefined isFieldName"++-- ---------------------------------------------------------------------+-- | True if the name is a field name+isClassName :: GHC.Name -> Bool+isClassName _n = error "undefined isClassName"++-- ---------------------------------------------------------------------+-- | True if the name is a class instance+isInstanceName :: GHC.Name -> Bool+isInstanceName _n = error "undefined isInstanceName"+++-- ---------------------------------------------------------------------+-- | Collect those type variables that are declared in a given syntax phrase t. In+-- the returned result, the first list is always be empty.+hsTypeVbls::(SYB.Data t) => t -> ([GHC.RdrName],[GHC.RdrName])+hsTypeVbls =ghead "hsTypeVbls".(applyTU (stop_tdTU (failTU `adhocTU` pnt)))+  where+    -- pnt (PNT (PN i (UniqueNames.S loc)) (Type _) _) = return ([], [(PN i (UniqueNames.S loc))])+    pnt n | GHC.rdrNameSpace n == GHC.tvName = return ([], [n])+    pnt _ = mzero+++-------------------------------------------------------------------------------++isDeclaredInRdr :: NameMap -> GHC.Name -> [GHC.LHsDecl GHC.RdrName] -> Bool+isDeclaredInRdr nm name decls = nonEmptyList $ definingDeclsRdrNames nm [name] decls False True++-- ---------------------------------------------------------------------++-- | Collect the free and declared variables (in the GHC.Name format)+-- in a given syntax phrase t. In the result, the first list contains+-- the free variables, and the second list contains the declared+-- variables.+-- Expects RenamedSource+hsFreeAndDeclaredRdr :: (SYB.Data t) => NameMap -> t -> (FreeNames,DeclaredNames)+hsFreeAndDeclaredRdr nm t = res+  where+    fd = hsFreeAndDeclaredRdr' nm t+    (FN f,DN d) = fromMaybe mempty fd+    res = (FN (f \\ d),DN d)++hsFreeAndDeclaredRdr':: (SYB.Data t) => NameMap -> t -> Maybe (FreeNames,DeclaredNames)+hsFreeAndDeclaredRdr' nm t = do+      (FN f,DN d) <- hsFreeAndDeclared'+      let (f',d') = (nub f, nub d)+      return (FN f',DN d')+          -- hsFreeAndDeclared'=applyTU (stop_tdTU (failTU  `adhocTU` exp++   where+          hsFreeAndDeclared' :: Maybe (FreeNames,DeclaredNames)+          hsFreeAndDeclared' = applyTU (stop_tdTU (failTU+                                                      `adhocTU` expr+                                                      `adhocTU` pat+                                                      `adhocTU` bndrs+                                                      `adhocTU` binds+                                                      `adhocTU` bindList+                                                      `adhocTU` match+                                                      `adhocTU` stmts+                                                      `adhocTU` rhs+                                                      `adhocTU` ltydecl+                                                      `adhocTU` hstype+                                                       )) t++          -- expr --+#if __GLASGOW_HASKELL__ <= 710+          expr (GHC.L l (GHC.HsVar n))+#else+          expr (GHC.L l (GHC.HsVar (GHC.L _ n)))+#endif+            = return (FN [rdrName2NamePure nm (GHC.L l n)],DN [])++#if __GLASGOW_HASKELL__ <= 710+          expr (GHC.L _ (GHC.OpApp e1 (GHC.L l (GHC.HsVar n)) _ e2)) = do+#else+          expr (GHC.L _ (GHC.OpApp e1 (GHC.L l (GHC.HsVar (GHC.L _ n))) _ e2)) = do+#endif+              efed <- hsFreeAndDeclaredRdr' nm [e1,e2]+              fd   <- addFree (rdrName2NamePure nm (GHC.L l n)) efed+              return fd++          expr (GHC.L _ ((GHC.HsLam (GHC.MG matches _ _ _))) :: GHC.LHsExpr GHC.RdrName) =+             hsFreeAndDeclaredRdr' nm matches++          expr (GHC.L _ ((GHC.HsLet decls e)) :: GHC.LHsExpr GHC.RdrName) =+            do+              (FN df,DN dd) <- hsFreeAndDeclaredRdr' nm decls+              (FN ef,_)  <- hsFreeAndDeclaredRdr' nm e+              return (FN (df `union` (ef \\ dd)),DN [])++#if __GLASGOW_HASKELL__ <= 710+          expr (GHC.L _ (GHC.RecordCon ln _ e)) = do+#else+          expr (GHC.L _ (GHC.RecordCon ln _ _ e)) = do+#endif+            fd <- (hsFreeAndDeclaredRdr' nm e)+            addFree (rdrName2NamePure nm ln) fd   --Need Testing++          expr (GHC.L _ (GHC.EAsPat ln e)) = do+            fd <- (hsFreeAndDeclaredRdr' nm e)+            addFree (rdrName2NamePure nm ln) fd++          expr _ = mzero+++          -- rhs --+          rhs ((GHC.GRHSs g ds) :: GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName))+            = do (FN df,DN dd) <- hsFreeAndDeclaredRdr' nm g+                 (FN ef,DN ed) <- hsFreeAndDeclaredRdr' nm ds+                 return (FN $ df ++ ef, DN $ dd ++ ed)+++          -- pat --+          pat :: GHC.LPat GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          pat (GHC.L _ (GHC.WildPat _)) = mzero+#if __GLASGOW_HASKELL__ <= 710+          pat (GHC.L l (GHC.VarPat n))+#else+          pat (GHC.L l (GHC.VarPat (GHC.L _ n)))+#endif+            = return (FN [],DN [rdrName2NamePure nm (GHC.L l n)])+          pat (GHC.L _ (GHC.AsPat ln p)) = do+            let (f,DN d) = fromMaybe mempty $ hsFreeAndDeclaredRdr' nm p+            return (f,DN (rdrName2NamePure nm ln:d))++          pat (GHC.L _ (GHC.ParPat p)) = pat p+          pat (GHC.L _ (GHC.BangPat p)) = pat p+          pat (GHC.L _ (GHC.ListPat ps _ _)) = do+            fds <- mapM pat ps+            return $ mconcat fds+          pat (GHC.L _ (GHC.TuplePat ps _ _)) = do+            fds <- mapM pat ps+            return $ mconcat fds+          pat (GHC.L _ (GHC.PArrPat ps _)) = do+            fds <- mapM pat ps+            return $ mconcat fds+          pat (GHC.L _ (GHC.ConPatIn n det)) = do+            (FN f,DN d) <- details det+            return $ (FN [rdrName2NamePure nm n],DN d) <> (FN [],DN f)+          pat (GHC.L _ (GHC.ViewPat e p _)) = do+            fde <- hsFreeAndDeclaredRdr' nm e+            fdp <- pat p+            return $ fde <> fdp+          -- pat (GHC.QuasiQuotePat _)+          pat (GHC.L _ (GHC.LitPat _)) = return emptyFD+#if __GLASGOW_HASKELL__ <= 710+          pat (GHC.L _ (GHC.NPat _ _ _)) = return emptyFD+          pat (GHC.L _ (GHC.NPlusKPat n _ _ _)) = return (FN [],DN [rdrName2NamePure nm n])+#else+          pat (GHC.L _ (GHC.NPat _ _ _ _)) = return emptyFD+          pat (GHC.L _ (GHC.NPlusKPat n _ _ _ _ _)) = return (FN [],DN [rdrName2NamePure nm n])+#endif+          pat (GHC.L _ _p@(GHC.SigPatIn p b)) = do+            fdp <- pat p+            (FN fb,DN _db) <- hsFreeAndDeclaredRdr' nm b+            -- error $ "pat.SigPatIn:(b,fb,db)" ++ showGhc (b,fb,db)+            return $ fdp <> (FN fb,DN [])+          pat (GHC.L _ (GHC.SigPatOut p _)) = pat p+          pat (GHC.L l (GHC.CoPat _ p _)) = pat (GHC.L l p)++          pat (GHC.L _ (GHC.LazyPat p)) = pat p++          pat (GHC.L _ (GHC.ConPatOut {})) = error $ "hsFreeAndDeclaredRdr'.pat:impossible: ConPatOut"++#if __GLASGOW_HASKELL__ <= 710+          pat (GHC.L _ (GHC.SplicePat (GHC.HsSplice _ e))) = hsFreeAndDeclaredRdr' nm e+#else+          pat (GHC.L _ (GHC.SplicePat (GHC.HsQuasiQuote {})))     = return (FN [], DN [])+          pat (GHC.L _ (GHC.SplicePat (GHC.HsTypedSplice _ e)))   = hsFreeAndDeclaredRdr' nm e+          pat (GHC.L _ (GHC.SplicePat (GHC.HsUntypedSplice _ e))) = hsFreeAndDeclaredRdr' nm e+#endif++#if __GLASGOW_HASKELL__ <= 710+          pat (GHC.L _ (GHC.QuasiQuotePat _)) = return (FN [], DN [])+#endif++          -- pat p = error $ "hsFreeAndDeclaredRdr'.pat:unimplemented:" ++ (showGhc p)++          -- ---------------------------++          details :: GHC.HsConPatDetails GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          details (GHC.PrefixCon  args) = do+            -- logm $ "hsFreeAndDeclaredGhc.details:args=" ++ (showGhc args)+            fds <- mapM pat args+            return $ mconcat fds+          details (GHC.RecCon recf) =+            recfields recf+          details (GHC.InfixCon arg1 arg2) = do+            fds <- mapM pat [arg1,arg2]+            return $ mconcat fds++          -- Note: this one applies to HsRecFields in LPats+          recfields :: (GHC.HsRecFields GHC.RdrName (GHC.LPat GHC.RdrName)) -> Maybe (FreeNames,DeclaredNames)+          recfields (GHC.HsRecFields fields _) = do+            let args = map (\(GHC.L _ (GHC.HsRecField _ arg _)) -> arg) fields+            fds <- mapM pat args+            return $ mconcat fds++          -- -----------------------++#if __GLASGOW_HASKELL__ <= 710+          bndrs :: GHC.HsWithBndrs GHC.RdrName (GHC.LHsType GHC.RdrName) -> Maybe (FreeNames,DeclaredNames)+          bndrs (GHC.HsWB thing _ _ _) = do+            (FN ft,DN _dt) <- hsFreeAndDeclaredRdr' nm thing+            return (FN ft,DN [])+#else+          bndrs :: GHC.LHsSigWcType GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          bndrs (GHC.HsIB _ (GHC.HsWC _ _ ty)) = do+            (FN ft,DN _dt) <- hsFreeAndDeclaredRdr' nm ty+            -- return (FN dt,DN [])+            return (FN ft,DN [])+#endif++          -- ---------------------------++          bindList (ds :: [GHC.LHsBind GHC.RdrName])+            =do (FN f,DN d) <- recurseList ds+                return (FN (f\\d),DN d)++          -- match and patBind, same type--+#if __GLASGOW_HASKELL__ <= 710+          binds ((GHC.FunBind ln _ (GHC.MG matches _ _ _) _ _fvs _) :: GHC.HsBind GHC.RdrName)+#else+          binds ((GHC.FunBind ln (GHC.MG matches _ _ _) _ _fvs _) :: GHC.HsBind GHC.RdrName)+#endif+            = do+                (FN pf,_pd) <- hsFreeAndDeclaredRdr' nm matches+                let n = rdrName2NamePure nm ln+                return (FN (pf \\ [n]) ,DN [n])++          -- patBind --+          binds (GHC.PatBind pat' prhs _ _ds _) =+            do+              (FN pf,DN pd) <- hsFreeAndDeclaredRdr' nm pat'+              (FN rf,DN rd) <- hsFreeAndDeclaredRdr' nm prhs+              return (FN $ pf `union` (rf \\ pd),DN $ pd ++ rd)++          binds _ = mzero++          match ((GHC.Match _fn pats _mtype mrhs) :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName))+            = do+              (FN pf,DN pd) <- hsFreeAndDeclaredRdr' nm pats+              (FN rf,DN rd) <- hsFreeAndDeclaredRdr' nm mrhs+              return (FN (pf `union` (rf \\ (pd `union` rd))),DN [])++          -- stmts --+#if __GLASGOW_HASKELL__ <= 710+          stmts ((GHC.BindStmt pat' expre _bindOp _failOp) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#else+          stmts ((GHC.BindStmt pat' expre _bindOp _failOp _) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#endif+            -- TODO ++AZ++ : Not sure it is meaningful to pull+            --               anything out of bindOp/failOp+            (FN pf,DN pd)  <- hsFreeAndDeclaredRdr' nm pat'+            (FN ef,_ed) <- hsFreeAndDeclaredRdr' nm expre+            let sf1 = []+            return (FN $ pf `union` ef `union` (sf1\\pd),DN []) -- pd) -- Check this++          stmts ((GHC.LetStmt binds') :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =+            hsFreeAndDeclaredRdr' nm binds'++          stmts _ = mzero++          -- tycldecls -----------------++          ltydecl :: GHC.TyClDecl GHC.RdrName -> Maybe (FreeNames,DeclaredNames)++          ltydecl (GHC.FamDecl fd) = hsFreeAndDeclaredRdr' nm fd+          ltydecl (GHC.SynDecl ln _bndrs _rhs _fvs)+              = return (FN [],DN [rdrName2NamePure nm ln])+#if __GLASGOW_HASKELL__ <= 710+          ltydecl (GHC.DataDecl ln _bndrs defn _fvs) = do+              let dds = map (rdrName2NamePure nm) $ concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn+#else+          ltydecl (GHC.DataDecl ln _bndrs defn _c _fvs) = do+              let dds = map (rdrName2NamePure nm) $ concatMap (GHC.getConNames . GHC.unLoc) $ GHC.dd_cons defn+#endif+              return (FN [],DN (rdrName2NamePure nm ln:dds))+          ltydecl (GHC.ClassDecl _ctx ln _tyvars+                           _fds _sigs meths ats atds _docs _fvs) = do+             (_,md) <- hsFreeAndDeclaredRdr' nm meths+             (_,ad) <- hsFreeAndDeclaredRdr' nm ats+             (_,atd) <- hsFreeAndDeclaredRdr' nm atds+             return (FN [],DN [rdrName2NamePure nm ln] <> md <> ad <> atd)++          ------------------------------++          hstype :: GHC.LHsType GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+#if __GLASGOW_HASKELL__ <= 710+          hstype (GHC.L _ (GHC.HsForAllTy _ _ _ _ typ)) = hsFreeAndDeclaredRdr' nm typ+#else+          hstype (GHC.L _ (GHC.HsForAllTy _ typ)) = hsFreeAndDeclaredRdr' nm typ+#endif+#if __GLASGOW_HASKELL__ <= 710+          hstype (GHC.L l (GHC.HsTyVar n)) = return (FN [rdrName2NamePure nm (GHC.L l n)],DN [])+#else+          hstype (GHC.L _ (GHC.HsTyVar n)) = return (FN [rdrName2NamePure nm n],DN [])+#endif+          hstype (GHC.L _ (GHC.HsAppTy t1 t2)) = recurseList [t1,t2]+          hstype (GHC.L _ (GHC.HsFunTy t1 t2)) = recurseList [t1,t2]+          hstype (GHC.L _ (GHC.HsListTy typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsPArrTy typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsTupleTy _ typs)) = recurseList typs+          hstype (GHC.L _ (GHC.HsOpTy t1 _ t2)) = recurseList [t1,t2]+          hstype (GHC.L _ (GHC.HsParTy typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsIParamTy _ typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsEqTy t1 t2)) = recurseList [t1,t2]+          hstype (GHC.L _ (GHC.HsKindSig t1 t2)) = recurseList [t1,t2]+#if __GLASGOW_HASKELL__ <= 710+          hstype (GHC.L _ (GHC.HsQuasiQuoteTy _)) = return emptyFD+#endif+          hstype (GHC.L _ (GHC.HsSpliceTy _ _)) = return (FN [],DN [])+          hstype (GHC.L _ (GHC.HsDocTy _ typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsBangTy _ typ)) = hsFreeAndDeclaredRdr' nm typ+          hstype (GHC.L _ (GHC.HsRecTy cons)) = recurseList cons+          hstype (GHC.L _ (GHC.HsCoreTy _)) = return emptyFD+          hstype (GHC.L _ (GHC.HsExplicitListTy _ typs)) = recurseList typs+          hstype (GHC.L _ (GHC.HsExplicitTupleTy _ typs)) = recurseList typs+          hstype (GHC.L _ (GHC.HsTyLit _)) = return emptyFD+#if __GLASGOW_HASKELL__ <= 710+          hstype (GHC.L _ (GHC.HsWrapTy _ typ)) = hsFreeAndDeclaredRdr' nm typ+#endif+#if __GLASGOW_HASKELL__ <= 710+          hstype (GHC.L _ (GHC.HsWildcardTy)) = error "To implement: hstype, HsWildcardTy"+          hstype (GHC.L _ (GHC.HsNamedWildcardTy _)) = error "To implement: HsNamedWildcardTy"+#else+          hstype (GHC.L _ (GHC.HsWildCardTy _)) = error "To implement: hstype, HsWildcardTy"+#endif+#if __GLASGOW_HASKELL__ > 710+          hstype (GHC.L _ (GHC.HsQualTy (GHC.L _ ctxt) ty)) = recurseList (ty:ctxt)+          hstype (GHC.L _ (GHC.HsAppsTy as)) = do+            fds <- mapM doApp as+            return $ mconcat fds+            where+              doApp (GHC.L _ (GHC.HsAppInfix n)) = return (FN [rdrName2NamePure nm n],DN [])+              doApp (GHC.L _ (GHC.HsAppPrefix ty)) = hstype ty+#endif++          -- ---------------------------------++          recurseList xs = do+            fds <- mapM (hsFreeAndDeclaredRdr' nm) xs+            return $ mconcat fds++          ------------------------------++          addFree :: GHC.Name -> (FreeNames,DeclaredNames)+                  -> Maybe (FreeNames,DeclaredNames)+          addFree free (FN fr,de) = return (FN $ [free] `union` fr, de)++          -- hsFreeAndDeclaredList :: (SYB.Data t) => [t] -> Maybe (FreeNames,DeclaredNames)+          -- hsFreeAndDeclaredList l = do+          --   fds <- mapM (hsFreeAndDeclaredRdr' nm) l+          --   let+          --     unionF (FN a) (FN b) = FN (a `union` b)+          --     unionD (DN a) (DN b) = DN (a `union` b)+          --   return (foldr unionF mempty (map fst fds),+          --           foldr unionD mempty (map snd fds))+++-- |The same as `hsFreeAndDeclaredPNs` except that the returned+-- variables are in the String format.+hsFreeAndDeclaredNameStrings::(SYB.Data t)+  => t -> RefactGhc ([String],[String])+hsFreeAndDeclaredNameStrings t = do+  (f1,d1) <- hsFreeAndDeclaredPNs t+  return ((nub.map showGhc) f1, (nub.map showGhc) d1)+++-- | Return the free and declared Names in the given syntax fragment. The syntax+-- fragment MUST be parameterised by RdrName, else the empty list will be+-- returned.+hsFreeAndDeclaredPNs :: (SYB.Data t) => t -> RefactGhc ([GHC.Name],[GHC.Name])+hsFreeAndDeclaredPNs t = do+  -- (FN f,DN d) <- hsFreeAndDeclaredGhc t+  nm <- getRefactNameMap+  let (FN f,DN d) = hsFreeAndDeclaredRdr nm t+  return (f,d)++-- ---------------------------------------------------------------------++-- |Get the names of all types declared in the given declaration+-- getDeclaredTypesRdr :: GHC.LTyClDecl GHC.RdrName -> RefactGhc [GHC.Name]+getDeclaredTypesRdr :: GHC.LHsDecl GHC.RdrName -> RefactGhc [GHC.Name]+getDeclaredTypesRdr (GHC.L _ (GHC.TyClD decl)) = do+  nm <- getRefactNameMap+  case decl of+#if __GLASGOW_HASKELL__ <= 710+    (GHC.FamDecl (GHC.FamilyDecl _ ln _ _)) -> return [rdrName2NamePure nm ln]+#else+    (GHC.FamDecl (GHC.FamilyDecl _ ln _ _ _)) -> return [rdrName2NamePure nm ln]+#endif+    (GHC.SynDecl ln  _ _ _) -> return [rdrName2NamePure nm ln]+#if __GLASGOW_HASKELL__ <= 710+    (GHC.DataDecl ln _ defn _) -> do+      let dds = concatMap (GHC.con_names . GHC.unLoc) $ GHC.dd_cons defn+#else+    (GHC.DataDecl ln _ defn _ _) -> do+      let dds = concatMap (GHC.getConNames . GHC.unLoc) $ GHC.dd_cons defn+#endif+      let ddns = map (rdrName2NamePure nm) dds+      return $ [rdrName2NamePure nm ln] ++ ddns++    (GHC.ClassDecl _ ln _vars _fds sigs meths ats _atdefs _ _fvs) -> do+      -- msn <- getMsn meths+      let msn = getDeclaredVarsRdr nm (map wrapDecl $ GHC.bagToList meths)+      let fds = map (GHC.fdLName . GHC.unLoc) ats+          fds' = map (rdrName2NamePure nm) fds+      return $ nub $ [rdrName2NamePure nm ln] ++ ssn ++ msn ++ fds' -- ++ asn+      where+        getLSig :: GHC.LSig GHC.RdrName -> [GHC.Name]+#if __GLASGOW_HASKELL__ <= 710+        getLSig (GHC.L _ (GHC.TypeSig ns _ _))  = map (rdrName2NamePure nm) ns+#else+        getLSig (GHC.L _ (GHC.TypeSig ns _))  = map (rdrName2NamePure nm) ns+#endif+#if __GLASGOW_HASKELL__ <= 710+        getLSig (GHC.L _ (GHC.GenericSig ns _)) = map (rdrName2NamePure nm) ns+#else+        getLSig (GHC.L _ (GHC.ClassOpSig _ ns _)) = map (rdrName2NamePure nm) ns+#endif+        getLSig (GHC.L _ (GHC.IdSig _n)) = []+        getLSig (GHC.L _ (GHC.InlineSig ln2 _)) = [rdrName2NamePure nm ln2]+        getLSig (GHC.L _ (GHC.SpecSig ln2 _ _)) = [rdrName2NamePure nm ln2]+        getLSig (GHC.L _ (GHC.SpecInstSig _ _)) = []+        getLSig (GHC.L _ (GHC.FixSig _)) = []+#if __GLASGOW_HASKELL__ <= 710+        getLSig (GHC.L _ (GHC.PatSynSig _ _ _ _ _)) = error "To implement: getLSig PatSynSig"+#else+        getLSig (GHC.L _ (GHC.PatSynSig _ _)) = error "To implement: getLSig PatSynSig"+#endif+        getLSig (GHC.L _ (GHC.MinimalSig _ _)) = error "To implement: getLSig PatSynSig"++        ssn = concatMap getLSig sigs+getDeclaredTypesRdr _ = return []++-- ---------------------------------------------------------------------++-- | Return True if the specified Name ocuurs in the given syntax phrase.+findNameInRdr :: (SYB.Data t) => NameMap -> GHC.Name -> t -> Bool+findNameInRdr nm pn t = findNamesRdr nm [pn] t++-- ---------------------------------------------------------------------++-- | Return True if any of the specified PNames ocuur in the given syntax phrase.+findNamesRdr :: (SYB.Data t) => NameMap -> [GHC.Name] -> t -> Bool+findNamesRdr nm pns t =+  isJust $ SYB.something (inName) t+    where+      -- r = (SYB.everythingStaged SYB.Parser mappend mempty (inName) t)++      checker :: GHC.Located GHC.RdrName -> Maybe Bool+      checker ln+         | elem (GHC.nameUnique (rdrName2NamePure nm ln)) uns = Just True+      checker _ = Nothing++      inName :: (SYB.Typeable a) => a -> Maybe Bool+      inName = nameSybQuery checker++      uns = map GHC.nameUnique pns++-- ---------------------------------------------------------------------++definedPNsRdr :: GHC.LHsDecl GHC.RdrName -> [GHC.Located GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+definedPNsRdr (GHC.L _ (GHC.ValD (GHC.FunBind pname _ _ _ _ _)))   = [pname]+#else+definedPNsRdr (GHC.L _ (GHC.ValD (GHC.FunBind pname _ _ _ _)))   = [pname]+#endif+definedPNsRdr (GHC.L _ (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) = (hsNamessRdr p)+-- VarBind will never occur in ParsedSource+-- TODO: what about GHC.AbsBinds?+definedPNsRdr  _ = []++-- ---------------------------------------------------------------------++definedNamesRdr :: NameMap -> GHC.LHsDecl GHC.RdrName -> [GHC.Name]+definedNamesRdr nameMap bind = map (rdrName2NamePure nameMap) (definedPNsRdr bind)++-- ---------------------------------------------------------------------++-- |Find those declarations(function\/pattern binding) which define+-- the specified GHC.Names. incTypeSig indicates whether the+-- corresponding type signature will be included.+definingDeclsRdrNames::+            NameMap+            ->[GHC.Name]   -- ^ The specified identifiers.+            ->[GHC.LHsDecl GHC.RdrName] -- ^ A collection of declarations.+            ->Bool       -- ^ True means to include the type signature.+            ->Bool       -- ^ True means to look at the local declarations as well.+            ->[GHC.LHsDecl GHC.RdrName]  -- ^ The result.+definingDeclsRdrNames nameMap pns ds _incTypeSig recursive = concatMap defining ds+-- ++AZ++:TODO: now we are processing decls again, reinstate incTypeSig function+  where+   defining decl+     = if recursive+        then SYB.everythingStaged SYB.Parser (++) [] ([]  `SYB.mkQ` definesDecl `SYB.extQ` definesBind)  decl+        else definesDecl decl+     where+      definesDecl :: (GHC.LHsDecl GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+      definesDecl decl'@(GHC.L _ (GHC.ValD (GHC.FunBind _ _ _ _ _ _)))+#else+      definesDecl decl'@(GHC.L _ (GHC.ValD (GHC.FunBind _ _ _ _ _)))+#endif+        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']++      definesDecl decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))+        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']++      definesDecl _ = []++      definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]+      definesBind (GHC.L l b) = definesDecl (GHC.L l (GHC.ValD b))++-- ---------------------------------------------------------------------++-- |Find those declarations(function\/pattern binding) which define+-- the specified GHC.Names. incTypeSig indicates whether the corresponding type+-- signature will be included.+definingDeclsRdrNames' :: (SYB.Data t)+            => NameMap+            -> [GHC.Name]   -- ^ The specified identifiers.+            -> t            -- ^ A collection of declarations.+            -> [GHC.LHsDecl GHC.RdrName]  -- ^ The result.+definingDeclsRdrNames' nameMap pns ds = defining ds+  where+   defining decl+     = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` defines' `SYB.extQ` definesBind) decl+     where+      defines' :: (GHC.LHsDecl GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]+      defines' decl'@(GHC.L _ (GHC.ValD (GHC.FunBind{})))+        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']++      defines' decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))+        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']++      defines' _ = []++      definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]+      definesBind (GHC.L l b) = defines' (GHC.L l (GHC.ValD b))++-- ---------------------------------------------------------------------++-- |Find those type signatures for the specified GHC.Names.+definingSigsRdrNames :: (SYB.Data t) =>+            NameMap+            ->[GHC.Name] -- ^ The specified identifiers.+            ->t        -- ^ A collection of declarations.+            ->[GHC.LSig GHC.RdrName]  -- ^ The result.+definingSigsRdrNames nameMap pns ds = def ds+  where+   def decl+     -- = SYB.everythingStaged SYB.Renamer (++) [] ([]  `SYB.mkQ` inSig) decl+     = SYB.everything (++) ([]  `SYB.mkQ` inSig `SYB.extQ` inSigDecl) decl+     where+      inSigDecl :: GHC.LHsDecl GHC.RdrName -> [GHC.LSig GHC.RdrName]+      inSigDecl (GHC.L l (GHC.SigD s)) = inSig (GHC.L l s)+      inSigDecl _ = []++      inSig :: (GHC.LSig GHC.RdrName) -> [GHC.LSig GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+      inSig (GHC.L l (GHC.TypeSig ns t p))+       | defines' ns /= [] = [(GHC.L l (GHC.TypeSig (defines' ns) t p))]+#else+      inSig (GHC.L l (GHC.TypeSig ns t))+       | defines' ns /= [] = [(GHC.L l (GHC.TypeSig (defines' ns) t))]+#endif+      inSig _ = []++      defines' :: [GHC.Located GHC.RdrName] -> [GHC.Located GHC.RdrName]+      defines' p+        -- = filter (\(GHC.L _ n) -> n `elem` pns) p+        = let+             isDefined :: GHC.Located GHC.RdrName -> [GHC.Located GHC.RdrName]+             isDefined ln = if (rdrName2NamePure nameMap ln) `elem` pns+                              then [ln]+                              else []+          in concatMap isDefined p++-- ---------------------------------------------------------------------++-- |Find those declarations which define the specified GHC.Names.+definingTyClDeclsNames:: (SYB.Data t)+            => NameMap+            -> [GHC.Name]   -- ^ The specified identifiers.+            -> t -- ^ A collection of declarations.+            ->[GHC.LTyClDecl GHC.RdrName]  -- ^ The result.+definingTyClDeclsNames nm pns t = defining t+  where+   defining decl+     = SYB.everythingStaged SYB.Parser (++) []+                   ([]  `SYB.mkQ` defines'+                        `SYB.extQ` definesDecl) decl+     where+      defines' :: (GHC.LTyClDecl GHC.RdrName) -> [GHC.LTyClDecl GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+      defines' decl'@(GHC.L _ (GHC.FamDecl (GHC.FamilyDecl _ pname _ _)))+#else+      defines' decl'@(GHC.L _ (GHC.FamDecl (GHC.FamilyDecl _ pname _ _ _)))+#endif+        | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        | otherwise = []++      defines' decl'@(GHC.L _ (GHC.SynDecl pname _ _ _))+        | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        | otherwise = []++#if __GLASGOW_HASKELL__ <= 710+      defines' decl'@(GHC.L _ (GHC.DataDecl pname _ _ _))+#else+      defines' decl'@(GHC.L _ (GHC.DataDecl pname _ _ _ _))+#endif+        | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        | otherwise = []++      defines' decl'@(GHC.L _ (GHC.ClassDecl _ pname _ _ _ _ _ _ _ _))+        | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        | otherwise = []++      definesDecl (GHC.L l (GHC.TyClD d)) = defines' (GHC.L l d)+      definesDecl _ = []++      uns = map (\n -> GHC.nameUnique n) pns++-- ---------------------------------------------------------------------++-- | Return True if the function\/pattern binding defines the+-- specified identifier.+definesRdr :: NameMap -> GHC.Name -> GHC.LHsBind GHC.RdrName -> Bool+#if __GLASGOW_HASKELL__ <= 710+definesRdr nm  nin (GHC.L _ (GHC.FunBind ln _ _ _ _ _))+#else+definesRdr nm nin (GHC.L _ (GHC.FunBind ln _ _ _ _))+#endif+  = GHC.nameUnique (rdrName2NamePure nm ln) == GHC.nameUnique nin+definesRdr nm n (GHC.L _ (GHC.PatBind p _rhs _ty _fvs _))+  = elem n (map (rdrName2NamePure nm) (hsNamessRdr p))+definesRdr _ _ _= False++-- |Unwraps a LHsDecl and calls definesRdr on the result if a HsBind+definesDeclRdr :: NameMap -> GHC.Name -> GHC.LHsDecl GHC.RdrName -> Bool+definesDeclRdr nameMap nin (GHC.L l (GHC.ValD d)) = definesRdr nameMap nin (GHC.L l d)+definesDeclRdr _ _ _ = False++-- ---------------------------------------------------------------------++-- | Return True if the declaration defines the type signature of the+-- specified identifier.+definesTypeSigRdr :: NameMap -> GHC.Name -> GHC.Sig GHC.RdrName -> Bool+#if __GLASGOW_HASKELL__ <= 710+definesTypeSigRdr nameMap pn (GHC.TypeSig names _typ _)+#else+definesTypeSigRdr nameMap pn (GHC.TypeSig names _typ)+#endif+  = elem (GHC.nameUnique pn) (map (GHC.nameUnique . rdrName2NamePure nameMap) names)+-- definesTypeSigRdr _ _  _ = False+definesTypeSigRdr _ _  x = error $ "definesTypeSigRdr : got " ++ SYB.showData SYB.Parser 0 x++-- |Unwraps a LHsDecl and calls definesRdr on the result if a Sig+definesSigDRdr :: NameMap -> GHC.Name -> GHC.LHsDecl GHC.RdrName -> Bool+definesSigDRdr nameMap nin (GHC.L _ (GHC.SigD d)) = definesTypeSigRdr nameMap nin d+definesSigDRdr _ _ _ = False++-- ---------------------------------------------------------------------++-- |Get all the names in the given syntax element+hsNamessRdr :: (SYB.Data t) => t -> [GHC.Located GHC.RdrName]+hsNamessRdr t = nub $ fromMaybe [] r+  where+     r = (SYB.everythingStaged SYB.Parser mappend mempty (inName) t)++     checker :: GHC.Located GHC.RdrName -> Maybe [GHC.Located GHC.RdrName]+     checker x = Just [x]++     inName :: (SYB.Typeable a) => a -> Maybe [GHC.Located GHC.RdrName]+     inName = nameSybQuery checker++-- ---------------------------------------------------------------------++-- |Does the given 'GHC.Name' appear as a 'GHC.Located' 'GHC.RdrName' anywhere in 't'?+findLRdrName :: (SYB.Data t) => NameMap -> GHC.Name -> t -> Bool+findLRdrName nm n t = isJust $ SYB.something isMatch t+  where+    checker :: GHC.Located GHC.RdrName -> Maybe Bool+    checker x+      | GHC.nameUnique (rdrName2NamePure nm x) == GHC.nameUnique n = Just True+      | otherwise = Nothing++    isMatch :: (SYB.Typeable a) => a -> Maybe Bool+    isMatch = nameSybQuery checker++-- ---------------------------------------------------------------------+++getDeclaredVarsRdr :: NameMap -> [GHC.LHsDecl GHC.RdrName] -> [GHC.Name]+getDeclaredVarsRdr nm bs = concatMap vars bs+  where+      vars :: (GHC.LHsDecl GHC.RdrName) -> [GHC.Name]+#if __GLASGOW_HASKELL__ <= 710+      vars (GHC.L _ (GHC.ValD (GHC.FunBind ln _ _ _ _fvs _)))   = [rdrName2NamePure nm ln]+#else+      vars (GHC.L _ (GHC.ValD (GHC.FunBind ln _ _ _ _fvs)))   = [rdrName2NamePure nm ln]+#endif+      vars (GHC.L _ (GHC.ValD (GHC.PatBind p _rhs _ty _fvs _))) = (map (rdrName2NamePure nm) $ hsNamessRdr p)+      vars _ = []++--------------------------------------------------------------------------------+-- | Same as `hsVisiblePNsRdr' except that the returned identifiers are+-- in String format.+hsVisibleNamesRdr:: (SYB.Data t2)+  => GHC.Name -> t2 -> RefactGhc [String]+hsVisibleNamesRdr e t = do+    nm <- getRefactNameMap+    (DN d) <- hsVisibleDsRdr nm e t+    return ((nub . map showGhc) d)++------------------------------------------------------------------------++-- | Given a 'Name' n and a syntax phrase t, if n occurs in t, then return those+-- variables which are declared in t and accessible to n, otherwise+-- return [].+hsVisibleDsRdr :: (SYB.Data t)+             => NameMap -> GHC.Name -> t -> RefactGhc DeclaredNames+hsVisibleDsRdr nm e t = do+  -- logm $ "hsVisibleDsRdr:(e,t)=" ++ (SYB.showData SYB.Renamer 0 (e,t))+  (DN d) <- res+  return (DN (nub d))+  where+    -- TODO: this is effectively a recursive descent approach, where+    --       each syntax element processor knows exactly what it needs+    --       in terms of sub-elements. Hence as an optimisation,+    --       consider calling the relevent element directly, instead+    --       of looping back into the main function.+    res = (const err -- (DN [])+          `SYB.extQ` parsed+          `SYB.extQ` lvalbinds+          `SYB.extQ` valbinds+          `SYB.extQ` lhsdecls+          `SYB.extQ` lhsdecl+          `SYB.extQ` lhsbindslr+          `SYB.extQ` hsbinds+          `SYB.extQ` hsbind+          `SYB.extQ` hslocalbinds+          `SYB.extQ` lmatch+          `SYB.extQ` grhss+          `SYB.extQ` lgrhs+          `SYB.extQ` lexpr+          `SYB.extQ` tyclgroups+          `SYB.extQ` tyclgroup+          `SYB.extQ` tycldeclss+          `SYB.extQ` tycldecls+          `SYB.extQ` tycldecl+          `SYB.extQ` instdecls+          `SYB.extQ` instdecl+          `SYB.extQ` lhstype+          `SYB.extQ` lsigs+          `SYB.extQ` lsig+          `SYB.extQ` lstmts+          `SYB.extQ` lstmt+          `SYB.extQ` lpats+          `SYB.extQ` lpat+#if __GLASGOW_HASKELL__ > 710+          `SYB.extQ` ibndrs+          `SYB.extQ` lsigty+#endif+          ) t++    -- err2 = error $ "hsVisibleDsRdr:err2:no match for:" ++ (SYB.showData SYB.Renamer 0 t)++    parsed :: GHC.ParsedSource -> RefactGhc DeclaredNames+    parsed p+      | findNameInRdr nm e p = do+         -- dfds <- mapM (hsVisibleDsRdr nm e) $ GHC.hsmodDecls $ GHC.unLoc p+         logm $ "hsVisibleDsRdr parsedSource:decls starting"+         dfds <- mapM (declFun ( hsVisibleDsRdr nm e) ) $ GHC.hsmodDecls $ GHC.unLoc p+         logm $ "hsVisibleDsRdr parsedSource:decls done"+         return $ mconcat dfds+    parsed _ = return (DN [])++    lvalbinds :: (GHC.Located (GHC.HsLocalBinds GHC.RdrName)) -> RefactGhc DeclaredNames+    lvalbinds (GHC.L _ (GHC.HsValBinds vb)) = valbinds vb+    lvalbinds (GHC.L _ (GHC.HsIPBinds _))   = return (DN [])+    lvalbinds (GHC.L _ GHC.EmptyLocalBinds) = return (DN [])++    valbinds :: (GHC.HsValBinds GHC.RdrName) -> RefactGhc DeclaredNames+    valbinds vb@(GHC.ValBindsIn bindsBag sigs)+      | findNameInRdr nm e vb = do+          fdsb <- mapM (hsVisibleDsRdr nm e) $ GHC.bagToList bindsBag+          fdss <- mapM (hsVisibleDsRdr nm e) sigs+          return $ mconcat fdss <> mconcat fdsb+    valbinds vb@(GHC.ValBindsOut _binds _sigs)+      | findNameInRdr nm e vb = do+          logm $ "hsVisibleDsRdr valbinds:ValBindsOut:impossible for RdrName"+          return (DN [])++    valbinds _ = do+      logm $ "hsVisibleDsRdr nm.valbinds:not matched"+      return (DN [])++    lhsdecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc DeclaredNames+    lhsdecls ds+      | findNameInRdr nm e ds = do+         dfds <- mapM (declFun ( hsVisibleDsRdr nm e) ) ds+         return $ mconcat dfds+    lhsdecls _ = return (DN [])++    lhsdecl :: GHC.LHsDecl GHC.RdrName -> RefactGhc DeclaredNames+    lhsdecl (GHC.L l dd) = do+        logm $ "hsVisibleDsRdr.lhsdecl"+        case dd of+            GHC.TyClD d       -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.InstD d       -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.DerivD d      -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.ValD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.SigD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.DefD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.ForD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.WarningD d    -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.AnnD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.RuleD d       -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.VectD d       -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.SpliceD d     -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.DocD d        -> hsVisibleDsRdr nm e (GHC.L l d)+            GHC.RoleAnnotD d  -> hsVisibleDsRdr nm e (GHC.L l d)+#if __GLASGOW_HASKELL__ < 711+            GHC.QuasiQuoteD d -> hsVisibleDsRdr nm e (GHC.L l d)+#endif++    lhsbindslr :: GHC.LHsBinds GHC.RdrName -> RefactGhc DeclaredNames+    lhsbindslr bs = do+      fds <- mapM (hsVisibleDsRdr nm e) $ GHC.bagToList bs+      return $ mconcat fds++    hsbinds :: [GHC.LHsBind GHC.RdrName] -> RefactGhc DeclaredNames+    hsbinds ds+      | findNameInRdr nm e ds = do+        fds <- mapM (hsVisibleDsRdr nm e) ds+        return $ mconcat fds+    hsbinds _ = return (DN [])++    hsbind :: (GHC.LHsBind GHC.RdrName) -> RefactGhc DeclaredNames+#if __GLASGOW_HASKELL__ <= 710+    hsbind ((GHC.L _ (GHC.FunBind _n _ (GHC.MG matches _ _ _) _ _ _)))+#else+    hsbind ((GHC.L _ (GHC.FunBind _n (GHC.MG (GHC.L _ matches) _ _ _) _ _ _)))+#endif+      | findNameInRdr nm e matches = do+          fds <- mapM (hsVisibleDsRdr nm e) matches+          logm $ "hsVisibleDsRdr.hsbind:fds=" ++ show fds+          return $ mconcat fds+    hsbind _ = do+      -- logm $ "hsVisibleDsRdr.hsbind:miss"+      return (DN [])+++    hslocalbinds :: (GHC.HsLocalBinds GHC.RdrName) -> RefactGhc DeclaredNames+    hslocalbinds (GHC.HsValBinds binds)+      | findNameInRdr nm e binds = hsVisibleDsRdr nm e binds+    hslocalbinds (GHC.HsIPBinds binds)+      | findNameInRdr nm e binds = hsVisibleDsRdr nm e binds+    hslocalbinds (GHC.EmptyLocalBinds) = return (DN [])+    hslocalbinds _ = return (DN [])++    lmatch :: (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> RefactGhc DeclaredNames+    lmatch (GHC.L _ (GHC.Match _fn pats _mtyp rhs))+      | findNameInRdr nm e pats = do+           logm $ "hsVisibleDsRdr nm.lmatch:in pats="+           return (DN []) -- TODO: extend this+      | findNameInRdr nm e rhs = do+           logm $ "hsVisibleDsRdr nm.lmatch:doing rhs"+           let (pf,pd) = hsFreeAndDeclaredRdr nm pats+           logm $ "hsVisibleDsRdr nm.lmatch:(pf,pd)=" ++ (show (pf,pd))+           (    rd) <- hsVisibleDsRdr nm e rhs+           return (pd <> rd)+    lmatch _ =return  (DN [])++    grhss :: (GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> RefactGhc DeclaredNames+    grhss (GHC.GRHSs guardedRhss lstmts')+      | findNameInRdr nm e guardedRhss = do+          logm "hsVisibleDsRdr nm.grhss:about to do grhss"+          fds <- mapM (hsVisibleDsRdr nm e) guardedRhss+          logm "hsVisibleDsRdr nm.grhss:grhss done"+          return $ mconcat fds+      | findNameInRdr nm e lstmts' = do+          logm "hsVisibleDsRdr nm.grhss:about to do lstmts"+          hsVisibleDsRdr nm e lstmts'+    grhss _ = return (DN [])++    lgrhs :: GHC.LGRHS GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc DeclaredNames+    lgrhs (GHC.L _ (GHC.GRHS guards ex))+      | findNameInRdr nm e guards = logm "hsVisibleDsRdr nm.lgrhs.guards" >> hsVisibleDsRdr nm e guards+      | findNameInRdr nm e ex     = logm "hsVisibleDsRdr nm.lgrhs.ex"     >> hsVisibleDsRdr nm e ex+    lgrhs _ = return (DN [])+++    lexpr :: GHC.LHsExpr GHC.RdrName -> RefactGhc DeclaredNames+#if __GLASGOW_HASKELL__ <= 710+    lexpr (GHC.L l (GHC.HsVar n))+#else+    lexpr (GHC.L l (GHC.HsVar (GHC.L _ n)))+#endif+      | findNameInRdr nm e n  = do+        logm $ "hsVisibleDsRdr.lexpr.HsVar entity found"+        return (DN [rdrName2NamePure nm (GHC.L l n)])+    lexpr (GHC.L _ (GHC.HsLet lbinds expr))+      | findNameInRdr nm e lbinds || findNameInRdr nm e expr  = do+        logm $ "hsVisibleDsRdr.lexpr.HsLet entity found"+        let (_,lds) = hsFreeAndDeclaredRdr nm lbinds+        let (_,eds) = hsFreeAndDeclaredRdr nm expr+        return $ lds <> eds++    lexpr expr+      | findNameInRdr nm e expr = do+        logm $ "hsVisibleDsRdr nm.lexpr.(e,expr):" ++ (showGhc (e,expr))+        let (FN efs,_)         = hsFreeAndDeclaredRdr nm expr+        let (FN _eefs,DN eeds) = hsFreeAndDeclaredRdr nm e+        logm $ "hsVisibleDsRdr nm.lexpr done"+        -- return (DN e1fs <> DN eofs <> DN e2fs)+        return (DN (efs \\ eeds))++    lexpr x = do+      logm $ "hsVisibleDsRdr.lexpr:miss for:" ++ SYB.showData SYB.Parser 0 x+      return (DN [])++    -- ---------------------------------++    tyclgroups :: [GHC.TyClGroup GHC.RdrName] -> RefactGhc DeclaredNames+    tyclgroups tgrps+      | findNameInRdr nm e tgrps = do+        fds <- mapM (hsVisibleDsRdr nm e) tgrps+        return $ mconcat fds+    tyclgroups _ = return (DN [])++    tyclgroup :: GHC.TyClGroup GHC.RdrName -> RefactGhc DeclaredNames+    tyclgroup (GHC.TyClGroup tyclds _roles)+      | findNameInRdr nm e tyclds = do+        fds <- mapM (hsVisibleDsRdr nm e) tyclds+        return $ mconcat fds+    tyclgroup _ = return (DN [])++    tycldeclss :: [[GHC.LTyClDecl GHC.RdrName]] -> RefactGhc DeclaredNames+    tycldeclss tcds+      | findNameInRdr nm e tcds = do+        fds <- mapM (hsVisibleDsRdr nm e) tcds+        return $ mconcat fds+    tycldeclss _ = return (DN [])++    tycldecls :: [GHC.LTyClDecl GHC.RdrName] -> RefactGhc DeclaredNames+    tycldecls tcds+      | findNameInRdr nm e tcds = do+        logm $ "hsVisibleDsRdr.tycldecls"+        fds <- mapM (hsVisibleDsRdr nm e) tcds+        logm $ "hsVisibleDsRdr.tycldecls done"+        return $ mconcat fds+    tycldecls _ = return (DN [])++    tycldecl :: GHC.LTyClDecl GHC.RdrName -> RefactGhc DeclaredNames+    tycldecl tcd+      | findNameInRdr nm e tcd = do+        logm $ "hsVisibleDsRdr.tycldecl"+        let (_,ds) = hsFreeAndDeclaredRdr nm tcd+        logm $ "hsVisibleDsRdr.tycldecl done"+        return ds+    tycldecl _ = return (DN [])++    -- ---------------------------------++    instdecls :: [GHC.LInstDecl GHC.RdrName] -> RefactGhc DeclaredNames+    instdecls ds+      | findNameInRdr nm e ds = do+        fds <- mapM (hsVisibleDsRdr nm e) ds+        return $ mconcat fds+    instdecls _ = return (DN [])++    instdecl :: GHC.LInstDecl GHC.RdrName -> RefactGhc DeclaredNames+    instdecl (GHC.L _ (GHC.ClsInstD (GHC.ClsInstDecl polytyp binds sigs tyfaminsts dfaminsts _)))+      | findNameInRdr nm e polytyp    = hsVisibleDsRdr nm e polytyp+      | findNameInRdr nm e binds      = hsVisibleDsRdr nm e binds+      | findNameInRdr nm e sigs       = hsVisibleDsRdr nm e sigs+      | findNameInRdr nm e tyfaminsts = hsVisibleDsRdr nm e tyfaminsts+      | findNameInRdr nm e dfaminsts  = hsVisibleDsRdr nm e dfaminsts+      | otherwise = return (DN [])+    instdecl (GHC.L _ (GHC.DataFamInstD (GHC.DataFamInstDecl _ln pats defn _)))+      | findNameInRdr nm e pats = hsVisibleDsRdr nm e pats+      | findNameInRdr nm e defn = hsVisibleDsRdr nm e defn+      | otherwise = return (DN [])+    instdecl (GHC.L _ (GHC.TyFamInstD (GHC.TyFamInstDecl eqn _)))+      | findNameInRdr nm e eqn = hsVisibleDsRdr nm e eqn+      | otherwise = return (DN [])++    lhstype :: GHC.LHsType GHC.RdrName -> RefactGhc DeclaredNames+#if __GLASGOW_HASKELL__ <= 710+    lhstype tv@(GHC.L l (GHC.HsTyVar n))+#else+    lhstype tv@(GHC.L l (GHC.HsTyVar (GHC.L _ n)))+#endif+      | findNameInRdr nm e tv = return (DN [rdrName2NamePure nm (GHC.L l n)])+      | otherwise       = return (DN [])+    lhstype (GHC.L _ (GHC.HsForAllTy {}))+        = return (DN [])+    lhstype (GHC.L _ (GHC.HsFunTy{})) = return (DN [])+    lhstype ty = do+      logm $ "lshtype: TypeUtils 1588" ++ SYB.showData SYB.Renamer 0 ty+      return (DN [])++    -- -----------------------++    lsigs :: [GHC.LSig GHC.RdrName] -> RefactGhc DeclaredNames+    lsigs ss = do+      fds <- mapM (hsVisibleDsRdr nm e) ss+      return $ mconcat fds++    -- -----------------------++    lsig :: GHC.LSig GHC.RdrName -> RefactGhc DeclaredNames+#if __GLASGOW_HASKELL__ <= 710+    lsig (GHC.L _ (GHC.TypeSig _ns typ _))+#else+    lsig (GHC.L _ (GHC.TypeSig _ns typ))+#endif+      | findNameInRdr nm e typ = hsVisibleDsRdr nm e typ+#if __GLASGOW_HASKELL__ <= 710+    lsig (GHC.L _ (GHC.GenericSig _n typ))+#else+    lsig (GHC.L _ (GHC.ClassOpSig _ _n (GHC.HsIB _ typ)))+#endif+      | findNameInRdr nm e typ = hsVisibleDsRdr nm e typ+    lsig (GHC.L _ (GHC.IdSig _)) = return (DN [])+    lsig (GHC.L _ (GHC.InlineSig _ _)) = return (DN [])+    lsig (GHC.L _ (GHC.SpecSig _n typ _))+      | findNameInRdr nm e typ = hsVisibleDsRdr nm e typ+    lsig (GHC.L _ (GHC.SpecInstSig _ _)) = return (DN [])++    lsig _ = return (DN [])++    -- -----------------------++    lstmts :: [GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)] -> RefactGhc DeclaredNames+    lstmts ds+      | findNameInRdr nm e ds = do+        fds <- mapM (hsVisibleDsRdr nm e) ds+        return $ mconcat fds+    lstmts _ = return (DN [])++    -- -----------------------++    lstmt :: GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc DeclaredNames+#if __GLASGOW_HASKELL__ <= 710+    lstmt (GHC.L _ (GHC.LastStmt ex _)) = hsVisibleDsRdr nm e ex+#else+    lstmt (GHC.L _ (GHC.LastStmt ex _ _)) = hsVisibleDsRdr nm e ex+#endif+#if __GLASGOW_HASKELL__ <= 710+    lstmt (GHC.L _ (GHC.BindStmt pa ex _ _)) = do+#else+    lstmt (GHC.L _ (GHC.BindStmt pa ex _ _ _)) = do+#endif+      fdp <- hsVisibleDsRdr nm e pa+      fde <- hsVisibleDsRdr nm e ex+      return (fdp <> fde)+    lstmt (GHC.L _ (GHC.BodyStmt ex _ _ _)) = hsVisibleDsRdr nm e ex++    lstmt (GHC.L _ (GHC.LetStmt bs)) = hsVisibleDsRdr nm e bs+#if __GLASGOW_HASKELL__ <= 710+    lstmt (GHC.L _ (GHC.ParStmt ps _ _)) = hsVisibleDsRdr nm e ps+#else+    lstmt (GHC.L _ (GHC.ParStmt ps _ _ _)) = hsVisibleDsRdr nm e ps+#endif+#if __GLASGOW_HASKELL__ <= 710+    lstmt (GHC.L _ (GHC.TransStmt _ stmts _ using mby _ _ _)) = do+#else+    lstmt (GHC.L _ (GHC.TransStmt _ stmts _ using mby _ _ _ _)) = do+#endif+      fds <- hsVisibleDsRdr nm e stmts+      fdu <- hsVisibleDsRdr nm e using+      fdb <- case mby of+        Nothing -> return (DN [])+        Just ex -> hsVisibleDsRdr nm e ex+      return $ fds <> fdu <> fdb+#if __GLASGOW_HASKELL__ <= 710+    lstmt (GHC.L _ (GHC.RecStmt stmts _ _ _ _ _ _ _ _)) = hsVisibleDsRdr nm e stmts+#else+    lstmt (GHC.L _ (GHC.RecStmt stmts _ _ _ _ _ _ _ _ _)) = hsVisibleDsRdr nm e stmts+#endif++#if __GLASGOW_HASKELL__ > 710+    lstmt (GHC.L _ (GHC.ApplicativeStmt {})) = return mempty+#endif+    -- lstmt _ = return (DN [])++    -- -----------------------++    lpats :: [GHC.LPat GHC.RdrName] -> RefactGhc DeclaredNames+    lpats ps+      | findNameInRdr nm e ps = do+        fds <- mapM (hsVisibleDsRdr nm e) ps+        return $ mconcat fds+    lpats _ = return (DN [])++    -- -----------------------++    lpat :: GHC.LPat GHC.RdrName -> RefactGhc DeclaredNames+    lpat (GHC.L _ (GHC.WildPat _)) = return (DN [])+#if __GLASGOW_HASKELL__ <= 710+    lpat (GHC.L l (GHC.VarPat n))+#else+    lpat (GHC.L l (GHC.VarPat (GHC.L _ n)))+#endif+      = return (DN [rdrName2NamePure nm (GHC.L l n)])+    lpat (GHC.L _ (GHC.AsPat ln p)) = do+      (DN dp) <- lpat p+      return (DN (rdrName2NamePure nm ln:dp))++    lpat (GHC.L _ (GHC.ParPat p)) = lpat p+    lpat (GHC.L _ (GHC.BangPat p)) = lpat p+    lpat (GHC.L _ (GHC.ListPat ps _ _)) = do+      fds <- mapM lpat ps+      return $ mconcat fds+    lpat (GHC.L _ (GHC.TuplePat ps _ _)) = do+      fds <- mapM lpat ps+      return $ mconcat fds+    lpat (GHC.L _ (GHC.PArrPat ps _)) = do+      fds <- mapM lpat ps+      return $ mconcat fds+    lpat (GHC.L _ (GHC.ConPatIn n det)) = do+      -- logm $ "hsFreeAndDeclaredGhc.lpat.ConPatIn:details=" ++ (SYB.showData SYB.Renamer 0 det)+      (DN d) <- details det+      return $ (DN (rdrName2NamePure nm n:d))+    -- lpat (GHC.ConPatOut )+    lpat (GHC.L _ (GHC.ViewPat ex p _)) = do+      fde <- hsVisibleDsRdr nm e ex+      fdp <- lpat p+      return $ fde <> fdp+    -- lpat (GHC.QuasiQuotePat _)+    lpat (GHC.L _ (GHC.LitPat _)) = return (DN [])+#if __GLASGOW_HASKELL__ <= 710+    lpat (GHC.L _ (GHC.NPat _ _ _)) = return (DN [])+    lpat (GHC.L _ (GHC.NPlusKPat n _ _ _)) = return (DN [rdrName2NamePure nm n])+#else+    lpat (GHC.L _ (GHC.NPat _ _ _ _)) = return (DN [])+    lpat (GHC.L _ (GHC.NPlusKPat n _ _ _ _ _)) = return (DN [rdrName2NamePure nm n])+#endif+    lpat (GHC.L _ _p@(GHC.SigPatIn p b)) = do+      dp <- lpat p+      db <- hsVisibleDsRdr nm e b+      -- error $ "lpat.SigPatIn:(b,fb,db)" ++ showGhc (b,fb,db)+      return $ dp <> db+    lpat (GHC.L _ (GHC.SigPatOut p _)) = lpat p+    lpat (GHC.L l (GHC.CoPat _ p _)) = lpat (GHC.L l p)++    lpat (GHC.L _ (GHC.LazyPat p)) = lpat p+    lpat (GHC.L _ (GHC.ConPatOut {})) = error $ "hsFreeAndDeclared.lpat:impossible GHC.ConPatOut"+#if __GLASGOW_HASKELL__ <= 710+    lpat (GHC.L _ (GHC.QuasiQuotePat _)) = return mempty+    lpat (GHC.L _ (GHC.SplicePat (GHC.HsSplice _ expr))) = hsVisibleDsRdr nm e expr+#else+    lpat (GHC.L _ (GHC.SplicePat (GHC.HsTypedSplice _ expr)))   = hsVisibleDsRdr nm e expr+    lpat (GHC.L _ (GHC.SplicePat (GHC.HsUntypedSplice _ expr))) = hsVisibleDsRdr nm e expr+    lpat (GHC.L _ (GHC.SplicePat (GHC.HsQuasiQuote {})))        = return mempty+#endif++    -- ---------------------------++    details :: GHC.HsConPatDetails GHC.RdrName -> RefactGhc DeclaredNames+    details (GHC.PrefixCon  args) = do+      -- logm $ "hsFreeAndDeclaredGhc.details:args=" ++ (showGhc args)+      fds <- mapM lpat args+      return $ mconcat fds+    details (GHC.RecCon recf) =+      recfields recf+    details (GHC.InfixCon arg1 arg2) = do+      fds <- mapM lpat [arg1,arg2]+      return $ mconcat fds++    -- Note: this one applies to HsRecFields in LPats+    recfields :: (GHC.HsRecFields GHC.RdrName (GHC.LPat GHC.RdrName)) -> RefactGhc DeclaredNames+    recfields (GHC.HsRecFields fields _) = do+      let args = map (\(GHC.L _ (GHC.HsRecField _ arg _)) -> arg) fields+      fds <- mapM lpat args+      return $ mconcat fds++    -- -----------------------+#if __GLASGOW_HASKELL__ > 710+    ibndrs :: GHC.LHsSigWcType GHC.RdrName -> RefactGhc DeclaredNames+    ibndrs (GHC.HsIB _ (GHC.HsWC _ _ ty)) = hsVisibleDsRdr nm e ty++    lsigty :: GHC.LHsSigType GHC.RdrName -> RefactGhc DeclaredNames+    lsigty (GHC.HsIB _ ty) = hsVisibleDsRdr nm e ty+#endif+    -- -----------------------++    err = error $ "hsVisibleDsRdr nm:no match for:" ++ (SYB.showData SYB.Parser 0 t)++-- ---------------------------------------------------------------------++-- |`hsFDsFromInsideRdr` is different from `hsFreeAndDeclaredPNs` in+-- that: given an syntax phrase t, `hsFDsFromInsideRdr` returns not only+-- the declared variables that are visible from outside of t, but also+-- those declared variables that are visible to the main expression+-- inside t.+-- NOTE: Expects to be given ParsedSource+hsFDsFromInsideRdr :: (SYB.Data t)+                  => NameMap ->  t -> (FreeNames,DeclaredNames)+hsFDsFromInsideRdr nm t = hsFDsFromInsideRdr' t+   where+     hsFDsFromInsideRdr' :: (SYB.Data t) => t -> (FreeNames,DeclaredNames)+     hsFDsFromInsideRdr' t1 = (FN $ nub f', DN $ nub d')+       where+          r1 = applyTU (once_tdTU (failTU  `adhocTU` parsed+                                           `adhocTU` decl+                                           `adhocTU` match+                                           `adhocTU` expr+                                           `adhocTU` stmts )) t1+          -- let (f',d') = fromMaybe ([],[]) r1+          (FN f',DN d') = fromMaybe (FN [],DN []) r1+          -- (FN f',DN d') = r1++     parsed :: GHC.ParsedSource -> Maybe (FreeNames,DeclaredNames)+     parsed p = return $ hsFreeAndDeclaredRdr nm p++     -- ----------------------++     match :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Maybe (FreeNames,DeclaredNames)+     match (GHC.Match _fn pats _type rhs) = do+       let (FN pf, DN pd) = hsFreeAndDeclaredRdr nm pats+           (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs+       return (FN $ nub (pf `union` (rf \\ pd)),+               DN $ nub (pd `union` rd))++     -- ----------------------++     decl :: GHC.HsBind GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+#if __GLASGOW_HASKELL__ <= 710+     decl (GHC.FunBind (GHC.L _ _) _ (GHC.MG matches _ _ _) _ _ _) = do+#else+     decl (GHC.FunBind (GHC.L _ _) (GHC.MG (GHC.L _ matches) _ _ _) _ _ _) = do+#endif+       let+         fds = map hsFDsFromInsideRdr' matches+         -- error (show $ nameToString n)+       return (FN $ nub (concat $ map (fn . fst) fds), DN $ nub (concat $ map (dn . snd) fds))++     decl ((GHC.PatBind p rhs _ _ _) :: GHC.HsBind GHC.RdrName) = do+       let+         (FN pf, DN pd) = hsFreeAndDeclaredRdr nm p+         (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs+       return+           (FN $ nub (pf `union` (rf \\ pd)),+            DN $ nub (pd `union` rd))++     decl ((GHC.VarBind p rhs _) :: GHC.HsBind GHC.RdrName) = do+       let+         (FN pf, DN pd) = hsFreeAndDeclaredRdr nm p+         (FN rf, DN rd) = hsFreeAndDeclaredRdr nm rhs+       return+           (FN $ nub (pf `union` (rf \\ pd)),+            DN $ nub (pd `union` rd))++     decl _ = mzero++     -- ----------------------++     expr ((GHC.HsLet decls e) :: GHC.HsExpr GHC.RdrName) = do+       let+         (FN df,DN dd) = hsFreeAndDeclaredRdr nm decls+         (FN ef,_)     = hsFreeAndDeclaredRdr nm e+       return (FN $ nub (df `union` (ef \\ dd)), DN $ nub dd)++     expr ((GHC.HsLam (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.RdrName) =+       return $ hsFreeAndDeclaredRdr nm matches++     expr ((GHC.HsCase e (GHC.MG matches _ _ _)) :: GHC.HsExpr GHC.RdrName) = do+       let+         (FN ef,_)     = hsFreeAndDeclaredRdr nm e+         (FN df,DN dd) = hsFreeAndDeclaredRdr nm matches+       return (FN $ nub (df `union` (ef \\ dd)), DN $ nub dd)++     expr _ = return (FN [],DN [])++#if __GLASGOW_HASKELL__ <= 710+     stmts ((GHC.BindStmt pat e1 e2 e3) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#else+     stmts ((GHC.BindStmt pat e1 e2 e3 _) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#endif+       let+         (FN pf,DN pd)  = hsFreeAndDeclaredRdr nm pat+         (FN ef,DN _ed) = hsFreeAndDeclaredRdr nm e1+         (FN df,DN dd)  = hsFreeAndDeclaredRdr nm [e2,e3]+       return+           (FN $ nub (pf `union` (((ef \\ dd) `union` df) \\ pd)), DN $ nub (pd `union` dd))++     stmts ((GHC.LetStmt binds) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =+       return $ hsFreeAndDeclaredRdr nm binds++     stmts _ = return (FN [],DN [])+++-- ---------------------------------------------------------------------++-- | The same as `hsFDsFromInside` except that the returned variables+-- are in the String format+hsFDNamesFromInsideRdr ::(SYB.Data t) => t -> RefactGhc ([String],[String])+hsFDNamesFromInsideRdr t = do+  nm <- getRefactNameMap+  return (hsFDNamesFromInsideRdrPure nm t)+  -- (FN f,DN d) <- hsFDsFromInsideRdr nm t+  -- return ((nub.map showGhc) f, (nub.map showGhc) d)++-- | The same as `hsFDsFromInside` except that the returned variables+-- are in the String format+hsFDNamesFromInsideRdrPure :: (SYB.Data t) => NameMap -> t -> ([String],[String])+hsFDNamesFromInsideRdrPure nm t = ((nub.map showGhc) f, (nub.map showGhc) d)+  where+    (FN f,DN d) = hsFDsFromInsideRdr nm t++-- ---------------------------------------------------------------------++rdrName2Name :: GHC.Located GHC.RdrName -> RefactGhc GHC.Name+rdrName2Name ln = do+  nameMap <- getRefactNameMap+  return (rdrName2NamePure nameMap ln)++rdrName2NamePure :: NameMap -> GHC.Located GHC.RdrName -> GHC.Name+rdrName2NamePure _nameMap (GHC.L _ (GHC.Exact n)) = n+rdrName2NamePure nameMap (GHC.L lrn _) =+  fromMaybe (error $ "rdrName2NamePure: no name found for" ++ showGhc lrn)+  -- fromMaybe (error $ "rdrName2NamePure: no name found for (lrn,e,nameMap)=" ++ showGhc (lrn,e,nameMap))+             (Map.lookup lrn nameMap)++eqRdrNamePure :: NameMap -> GHC.Located GHC.RdrName -> GHC.Name -> Bool+eqRdrNamePure nameMap rn n+  = GHC.nameUnique (rdrName2NamePure nameMap rn) == GHC.nameUnique n++-- ---------------------------------------------------------------------++-- |Find the identifier(in GHC.Name format) whose start position is+-- (row,col) in the file specified by the fileName, and returns+-- `Nothing` if such an identifier does not exist.+locToNameRdr :: (SYB.Data t)+                     => SimpPos          -- ^ The row and column number+                     -> t                -- ^ The syntax phrase, parameterised by RdrName+                     -> RefactGhc (Maybe GHC.Name)  -- ^ The result+locToNameRdr pos t = do+   nm <- getRefactNameMap+   let mn = locToRdrName pos t+   return $ fmap (rdrName2NamePure nm) mn++-- |Find the identifier(in GHC.Name format) whose start position is+-- (row,col) in the file specified by the fileName, and returns+-- `Nothing` if such an identifier does not exist.+locToNameRdrPure :: (SYB.Data t)+                    => NameMap+                    -> SimpPos         -- ^ The row and column number+                    -> t               -- ^ The syntax phrase, parameterised by RdrName+                    -> Maybe GHC.Name  -- ^ The result+locToNameRdrPure nm pos t =+  let mn = locToRdrName pos t+  in fmap (rdrName2NamePure nm) mn++-- |Find the identifier(in GHC.RdrName format) whose start position is+-- (row,col) in the file specified by the fileName, and returns+-- `Nothing` if such an identifier does not exist.+locToRdrName::(SYB.Data t)+                    =>SimpPos          -- ^ The row and column number+                    ->t                -- ^ The syntax phrase+                    -> Maybe (GHC.Located GHC.RdrName)  -- ^ The result+locToRdrName (row,col) t = locToName' (row,col) t+++-- |Worker for both locToName and locToRdrName.+-- NOTE: provides for FunBind MatchGroups where only the first name is+-- retained in the AST++locToName':: forall a t.(SYB.Data t, SYB.Data a)+                    =>SimpPos          -- ^ The row and column number+                    ->t                -- ^ The syntax phrase+                    -> Maybe (GHC.Located a)  -- ^ The result+locToName' (row,col) t = res1+     where+        res1 :: Maybe (GHC.Located a)+        res1 = SYB.something (nameSybQuery checker) t++        checker pnt =+          -- trace ("locToName':pnt=" ++ show (GHC.getLoc pnt)) $           if inScope pnt              then Just pnt              else Nothing

src/MainHaRe.hs view

@@ -1,156 +1,297 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+import           Control.Exception+import           Control.Monad.Writer.Lazy+import           Data.List+import           Data.Version+import           Development.GitRev (gitCommitCount)+import           Distribution.System (buildArch)+import           Distribution.Text (display)+import           Language.Haskell.Refact.API+import           Language.Haskell.Refact.HaRe+import           Options.Applicative.Simple+import qualified Language.Haskell.GhcMod as GM+import qualified Paths_HaRe as Meta --- Based on--- https://github.com/kazu-yamamoto/ghc-mod/blob/master/src/GHCMod.hs+-- temporary until exposed by ghc-mod+-- import           Options+import           Language.Haskell.GhcMod.Options.Options -import Control.Exception-import Data.List-import Data.Typeable-import Data.Version-import Language.Haskell.GhcMod-import Language.Haskell.Refact.HaRe-import Paths_HaRe-import Prelude-import System.Console.GetOpt-import System.Environment (getArgs)-import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8)+main :: IO ()+main = do+    -- Version code from stack. Maybe move this stuff into optparse-simple ?+    let commitCount = $gitCommitCount+        versionString' = concat $ concat+            [ [$(simpleVersion Meta.version)]+              -- Leave out number of commits for --depth=1 clone+              -- See https://github.com/commercialhaskell/stack/issues/792+            , [" (" ++ commitCount ++ " commits)" | commitCount /= ("1"::String) &&+                                                    commitCount /= ("UNKNOWN" :: String)]+            , [" ", display buildArch]+            ]+        numericVersion :: Parser (a -> a)+        numericVersion =+            infoOption+                (showVersion Meta.version)+                (long "numeric-version" <>+                 help "Show only version number")+    -- Parse the options and run the specified command.+    (global, run) <-+        simpleOptions+            versionString'+            "HaRe - the haskell refactorer"+            ""+            -- (numericVersion <*> globalOptsParser) $+            (numericVersion <*> allOptsParser) $+            do+              addCommand "demote"+                         "Demote a declaration"+                         runCmd+                         demoteCmdOpts -import Text.Parsec.Combinator-import Text.Parsec.Prim-import Text.Parsec.Char+              addCommand "dupdef"+                         "Duplicate a definition"+                         runCmd+                         dupDefCmdOpts -----------------------------------------------------------------+              addCommand "iftocase"+                         "Convert an if statement to a case statement"+                         runCmd+                         ifToCaseCmdOpts -ghcOptHelp :: String-ghcOptHelp = " [-g GHC_opt1 -g GHC_opt2 ...] "+              addCommand "liftOneLevel"+                         "Lift a definition up one level"+                         runCmd+                         liftOneLevelCmdOpts -usage :: String-usage =    "ghc-hare version " ++ showVersion version ++ "\n"-        ++ "Usage:\n"-        ++ "\t ghc-hare demote"         ++ ghcOptHelp ++ "filename line col\n"-        ++ "\t ghc-hare dupdef"         ++ ghcOptHelp ++ "filename newname line col\n"-        ++ "\t ghc-hare iftocase"       ++ ghcOptHelp ++ "filename startline startcol endline endcol\n"-        ++ "\t ghc-hare liftOneLevel"   ++ ghcOptHelp ++ "filename line col\n"-        ++ "\t ghc-hare liftToTopLevel" ++ ghcOptHelp ++ "filename line col\n"-        ++ "\t ghc-hare rename"         ++ ghcOptHelp ++ "filename newname line col\n"-        ++ "\t ghc-hare help\n"+              addCommand "liftToTopLevel"+                         "Lift a definition to the top level"+                         runCmd+                         liftToTopLevelCmdOpts -----------------------------------------------------------------+              addCommand "rename"+                         "Rename an identifier"+                         runCmd+                         renameCmdOpts -argspec :: [OptDescr (RefactSettings -> RefactSettings)]-argspec = [-             -- Option "m" ["mainfile"]-             --  (ReqArg (\mf opts -> opts { rsetMainFile = Just [mf] }) "FILE")-             --  "Main file name if not specified in cabal file"+              addCommand "addOneParam"+                         "Add a new parameter to a function in first position"+                         runCmd+                         addOneParamCmdOpts -          -- , Option "l" ["tolisp"]-          --     (NoArg (\opts -> opts { outputStyle = LispStyle }))-          --     "print as a list of Lisp"-          -- , Option "h" ["hlintOpt"]-          --     (ReqArg (\h opts -> opts { hlintOpts = h : hlintOpts opts }) "hlintOpt")-          --     "hlint options"-          -- , Option "g" ["ghcOpt"]-          --     (ReqArg (\g opts -> opts { rsetGhcOpts = g : rsetGhcOpts opts }) "ghcOpt")-          --     "GHC options"-          -- , Option "o" ["operators"]-          --     (NoArg (\opts -> opts { operators = True }))-          --     "print operators, too"-          -- , Option "d" ["detailed"]-          --     (NoArg (\opts -> opts { detailed = True }))-          --     "print detailed info"-            Option "v" ["verbose"]-              (NoArg (\opts -> opts { rsetVerboseLevel = Debug }))-              "debug logging on"-          -- , Option "b" ["boundary"]-          --   (ReqArg (\s opts -> opts { rsetLineSeparator = LineSeparator s }) "sep")-          --   "specify line separator (default is Nul string)"-          ]+              addCommand "rmOneParam"+                         "Remove a new parameter from a function"+                         runCmd+                         rmOneParamCmdOpts+    run global -parseArgs :: [OptDescr (RefactSettings -> RefactSettings)] -> [String] -> (RefactSettings, [String])-parseArgs spec argv-    = case getOpt Permute spec argv of-        (o,n,[]  ) -> (foldr id defaultSettings o, n)-        (_,_,errs) -> throw (CmdArg errs)+-- --------------------------------------------------------------------- -----------------------------------------------------------------+type Row = Int+type Col = Int -data HareError = SafeList-                 | NoSuchCommand String-                 | CmdArg [String]-                 | FileNotExist String deriving (Show, Typeable)+data HareParams = DemoteCmd      FilePath Row Col+                | DupDefCmd      FilePath String Row Col+                | IfToCaseCmd    FilePath Row Col Row Col+                | LiftOneLevel   FilePath Row Col+                | LiftToTopLevel FilePath Row Col+                | RenameCmd      FilePath String Row Col+                | AddOneParam    FilePath String Row Col+                | RmOneParam     FilePath Row Col+               deriving Show -instance Exception HareError+runCmd :: HareParams -> (RefactSettings,GM.Options) -> IO ()+runCmd (DemoteCmd fileName r c) (opt, gOpt)+  = runFunc $ demote opt gOpt fileName (r,c) -----------------------------------------------------------------+runCmd (DupDefCmd fileName newname r c) (opt, gOpt)+  = runFunc $ duplicateDef opt gOpt fileName newname (r,c) -main :: IO ()-main = flip catches handlers $ do-    hSetEncoding stdout utf8-    args <- getArgs-    let (opt,cmdArg) = parseArgs argspec args-    let cmdArg0 = cmdArg !. 0-        cmdArg1 = cmdArg !. 1-        cmdArg2 = cmdArg !. 2-        cmdArg3 = cmdArg !. 3-        cmdArg4 = cmdArg !. 4-        cmdArg5 = cmdArg !. 5-    -- putStrLn $ "cmdArg0=" ++ cmdArg0-    res <- case cmdArg0 of-      -- demote wants FilePath -> SimpPos-      "demote" -> runFunc $ demote opt defaultOptions cmdArg1 (parseSimpPos cmdArg2 cmdArg3)+runCmd (IfToCaseCmd fileName sr sc er ec) (opt, gOpt)+  = runFunc $ ifToCase opt gOpt fileName (sr,sc) (er,ec) -      -- dupdef wants FilePath -> String -> SimpPos-      "dupdef" -> runFunc $ duplicateDef opt defaultOptions cmdArg1 cmdArg2 (parseSimpPos cmdArg3 cmdArg4)+runCmd (LiftOneLevel fileName r c) (opt, gOpt)+  = runFunc $ liftOneLevel opt gOpt fileName (r,c) -      -- iftocase wants FilePath -> SimpPos -> SimpPos-      "iftocase" -> runFunc $ ifToCase opt defaultOptions cmdArg1 (parseSimpPos cmdArg2 cmdArg3) (parseSimpPos cmdArg4 cmdArg5)+runCmd (LiftToTopLevel fileName r c) (opt, gOpt)+  = runFunc $ liftToTopLevel opt gOpt fileName (r,c) -      -- liftOneLevel wants FilePath -> SimpPos-      "liftOneLevel" -> runFunc $ liftOneLevel opt defaultOptions cmdArg1 (parseSimpPos cmdArg2 cmdArg3)+runCmd (RenameCmd fileName newname r c) (opt, gOpt)+  = runFunc $ rename opt gOpt fileName newname (r,c) -      -- liftToTopLevel wants FilePath -> SimpPos-      "liftToTopLevel" -> runFunc $ liftToTopLevel opt defaultOptions cmdArg1 (parseSimpPos cmdArg2 cmdArg3)+runCmd (AddOneParam fileName newname r c) (opt, gOpt)+  = runFunc $ addOneParameter opt gOpt fileName newname (r,c) -      -- rename wants FilePath -> String -> SimpPos-      "rename" -> runFunc $ rename opt defaultOptions cmdArg1 cmdArg2 (parseSimpPos cmdArg3 cmdArg4)+runCmd (RmOneParam fileName r c) (opt, gOpt)+  = runFunc $ rmOneParameter opt gOpt fileName (r,c) -      -- roundtrip wants FilePath-      "roundtrip" -> runFunc $ roundTrip opt defaultOptions cmdArg1+-- --------------------------------------------------------------------- -      "show" -> putStrLn  (show (opt))+rmOneParamCmdOpts :: Parser HareParams+rmOneParamCmdOpts =+    LiftOneLevel+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the function name is on")+      <*> argument auto+            ( metavar "col"+           <> help "The col the function name starts at") -      cmd      -> throw (NoSuchCommand cmd)-    -- putStr (show res)-    -- putStr $ "(ok " ++ showLisp mfs ++ ")"-    return ()-  where-    handlers = [Handler handler1, Handler handler2]+-- --------------------------------------------------------------------- -    handler1 :: ErrorCall -> IO ()-    handler1 = print -- for debug+addOneParamCmdOpts :: Parser HareParams+addOneParamCmdOpts =+    AddOneParam+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> strArgument+            ( metavar "NAME"+           <> help "The name for the parameter"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the function name is on")+      <*> argument auto+            ( metavar "col"+           <> help "A col inside the function name name") -    handler2 :: HareError -> IO ()-    handler2 SafeList = printUsage-    handler2 (NoSuchCommand cmd) = do-        hPutStrLn stderr $ "\"" ++ cmd ++ "\" not supported"-        printUsage-    handler2 (CmdArg errs) = do-        mapM_ (hPutStr stderr) errs-        printUsage-    handler2 (FileNotExist file) = do-        hPutStrLn stderr $ "\"" ++ file ++ "\" not found"-        printUsage+-- --------------------------------------------------------------------- -    printUsage = hPutStrLn stderr $ '\n' : usageInfo usage argspec-    xs !. idx-      | length xs <= idx = throw SafeList-      | otherwise = xs !! idx+renameCmdOpts :: Parser HareParams+renameCmdOpts =+    RenameCmd+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> strArgument+            ( metavar "NEWNAME"+           <> help "The new name for the identifier"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the identifier is on")+      <*> argument auto+            ( metavar "col"+           <> help "A col inside the identifier name") +-- --------------------------------------------------------------------- -----------------------------------------------------------------+liftToTopLevelCmdOpts :: Parser HareParams+liftToTopLevelCmdOpts =+    LiftOneLevel+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the declaration is on")+      <*> argument auto+            ( metavar "col"+           <> help "The col the declaration starts at") +-- ---------------------------------------------------------------------++liftOneLevelCmdOpts :: Parser HareParams+liftOneLevelCmdOpts =+    LiftOneLevel+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the declaration is on")+      <*> argument auto+            ( metavar "col"+           <> help "The col the declaration starts at")++-- ---------------------------------------------------------------------++ifToCaseCmdOpts :: Parser HareParams+ifToCaseCmdOpts =+    IfToCaseCmd+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> argument auto+            ( metavar "startline"+           <> help "The line the if statement starts on")+      <*> argument auto+            ( metavar "startcol"+           <> help "The col the if statement starts at")++      <*> argument auto+            ( metavar "endline"+           <> help "The line the if statement ends on")+      <*> argument auto+            ( metavar "endcol"+           <> help "The col the if statement ends at")++-- ---------------------------------------------------------------------++demoteCmdOpts :: Parser HareParams+demoteCmdOpts =+    DemoteCmd+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the declaration is on")+      <*> argument auto+            ( metavar "col"+           <> help "The col the declaration starts at")++-- ---------------------------------------------------------------------++dupDefCmdOpts :: Parser HareParams+dupDefCmdOpts =+    DupDefCmd+      <$> strArgument+            ( metavar "FILE"+           <> help "Specify Haskell file to process"+            )+      <*> strArgument+            ( metavar "NEWNAME"+           <> help "The name for the new definition"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the definition is on")+      <*> argument auto+            ( metavar "col"+           <> help "A col inside the definition name")+++-- ---------------------------------------------------------------------++allOptsParser :: Parser (RefactSettings,GM.Options)+allOptsParser = (,) <$> globalOptsParser <*> globalArgSpec++globalOptsParser :: Parser RefactSettings+globalOptsParser = mkRefSet+     <$> ((\b -> if b then Debug else Normal) <$> switch+         ( long "debug"+        <> short 'd'+        <> help "Generate debug output" ))+  where+    mkRefSet v = RefSet v (True,True,True,True)++-- ---------------------------------------------------------------------++-- | Return the result of an Either as a sexp for emacs etc. runFunc :: IO [String] -> IO () runFunc f = do   r <- catchException f@@ -168,27 +309,4 @@   return res   where     handler:: SomeException -> IO (Either String t)-    handler e = return (Left (show e))--------------------------------------------------------------------parseSimpPos :: String -> String -> SimpPos-parseSimpPos str1 str2 = case (parse rowCol "" ((str1 ++ " " ++ str2))) of-                          Left err -> throw (CmdArg [(show err)])-                          Right val -> val--rowCol :: P (Int,Int)-rowCol = do-  row <- number "line number"-  _ <- spaces-  col <- number "column number"-  return (fromIntegral row, fromIntegral col)--type P = Parsec String ()---number :: String -> P Integer-number expectedStr = do { ds <- many1 digit; return (read ds) } <?> expectedStr-------------------------------------------------------------------+    handler e = return (Left (stripCallStack $ show e))

+ test/AddRmParamSpec.hs view

@@ -0,0 +1,495 @@+module AddRmParamSpec (main, spec) where++import           Test.Hspec++import Language.Haskell.Refact.Refactoring.AddRmParam++import TestUtils++import System.Directory++-- ---------------------------------------------------------------------++main :: IO ()+main = do+  hspec spec++spec :: Spec+spec = do++  describe "Adding" $ do+    it "addOneParameter in D3 A3" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/D3.hs" "y" (7,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/D3.hs" "y" (7,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/D3.hs"+                    , "AddOneParameter/A3.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/D3.expected.hs"+                                 "./AddOneParameter/D3.refactored.hs"+      diffD `shouldBe` []++      diffA <- ct $ compareFiles "./AddOneParameter/A3.expected.hs"+                                 "./AddOneParameter/A3.refactored.hs"+      diffA `shouldBe` []++    -- -------------------++    it "addOneParameter in D1 B1 C1 A1" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/D1.hs" "f" (10,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/D1.hs" "f" (10,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/D1.hs"+                    , "AddOneParameter/A1.hs"+                    , "AddOneParameter/C1.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/D1.expected.hs"+                                 "./AddOneParameter/D1.refactored.hs"+      diffD `shouldBe` []++      diffC <- ct $ compareFiles "./AddOneParameter/C1.expected.hs"+                                 "./AddOneParameter/C1.refactored.hs"+      diffC `shouldBe` []++      diffA <- ct $ compareFiles "./AddOneParameter/A1.expected.hs"+                                 "./AddOneParameter/A1.refactored.hs"+      diffA `shouldBe` []++    -- -------------------++    it "addOneParameter in D2 B2 C2 A2" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/D2.hs" "f" (11,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/D2.hs" "f" (11,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/D2.hs"+                    , "AddOneParameter/A2.hs"+                    , "AddOneParameter/C2.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/D2.expected.hs"+                                 "./AddOneParameter/D2.refactored.hs"+      diffD `shouldBe` []++      diffC <- ct $ compareFiles "./AddOneParameter/C2.expected.hs"+                                 "./AddOneParameter/C2.refactored.hs"+      diffC `shouldBe` []++      diffA <- ct $ compareFiles "./AddOneParameter/A2.expected.hs"+                                 "./AddOneParameter/A2.refactored.hs"+      diffA `shouldBe` []++    -- -------------------++    it "addOneParameter in PatIn1" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/PatIn1.hs" "x" (7,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/PatIn1.hs" "x" (7,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/PatIn1.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/PatIn1.expected.hs"+                                 "./AddOneParameter/PatIn1.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in FunIn1" $ do+      -- (["FunIn1.hs"],["y","7","1"]),+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn1.hs" "y" (7,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/FunIn1.hs" "y" (7,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/FunIn1.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/FunIn1.expected.hs"+                                 "./AddOneParameter/FunIn1.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in FunIn2" $ do+          -- (["FunIn2.hs"],["y","10","18"]),+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn2.hs" "y" (10,18)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/FunIn2.hs" "y" (10,18)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/FunIn2.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/FunIn2.expected.hs"+                                 "./AddOneParameter/FunIn2.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in FunIn3" $ do+          -- (["FunIn3.hs"],["y","9","11"]),+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn3.hs" "y" (9,11)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/FunIn3.hs" "y" (9,11)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/FunIn3.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/FunIn3.expected.hs"+                                 "./AddOneParameter/FunIn3.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in FunIn4" $ do+          -- (["FunIn4.hs"],["y","8","22"])],+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn4.hs" "y" (8,22)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/FunIn4.hs" "y" (8,22)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/FunIn4.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/FunIn4.expected.hs"+                                 "./AddOneParameter/FunIn4.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in FunIn6" $ do+          -- (["FunIn6.hs"],["y","8","22"])],+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn6.hs" "y" (9,7)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/FunIn6.hs" "y" (9,7)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/FunIn6.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/FunIn6.expected.hs"+                                 "./AddOneParameter/FunIn6.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in Nested" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/Nested.hs" "y" (8,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/Nested.hs" "y" (8,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/Nested.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/Nested.expected.hs"+                                 "./AddOneParameter/Nested.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "addOneParameter in MultiFun1" $ do+      r <- ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/MultiFun1.hs" "x" (9,1)+      -- r <- ct $ addOneParameter logTestSettings testOptions "./AddOneParameter/MultiFun1.hs" "x" (9,1)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "AddOneParameter/MultiFun1.hs"+                    ]++      diffD <- ct $ compareFiles "./AddOneParameter/MultiFun1.expected.hs"+                                 "./AddOneParameter/MultiFun1.refactored.hs"+      diffD `shouldBe` []++    -- ---------------------------------+    -- Negative tests+    -- ---------------------------------++    it "fails complex pat binding PatIn2" $ do+     -- [(["PatIn2.hs"],["x","7","20"]),+     res <- catchException (ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/PatIn2.hs" "x" (7,20))+     (show res) `shouldBe` "Just \"Parameter can not be added to complex pattern binding\""++    -- -------------------++    it "fails name clash FunIn5" $ do+         -- (["FunIn5.hs"],["h","8","1"])]+     res <- catchException (ct $ addOneParameter defaultTestSettings testOptions "./AddOneParameter/FunIn5.hs" "h" (8,1))+     (show res) `shouldBe` "Just \"The new parameter name will cause name clash or semantics change, please choose another name!\""++    -- -------------------+{-+TestCases{refactorCmd="addOneParameter",+positive=[(["D3.hs","A3.hs"],["y","7","1"]),+          (["D1.hs","C1.hs","A1.hs"],["f","10","1"]),+          (["D2.hs","C2.hs","A2.hs"],["f","11","1"]),+          (["PatIn1.hs"],["x","7","1"]),+          (["FunIn1.hs"],["y","7","1"]),+          (["FunIn2.hs"],["y","10","18"]),+          (["FunIn3.hs"],["y","9","11"]),+          (["FunIn4.hs"],["y","8","22"])],+negative=[(["PatIn2.hs"],["x","7","20"]),+         (["FunIn5.hs"],["h","8","1"])]++-}++    -- ---------------------------------++  describe "Removing" $ do+    it "rmOneParameter in D1 A1" $ do+          -- (["D1.hs","A1.hs"],["6","19"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/D1.hs" (6,19)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/D1.hs" (6,19)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/D1.hs"+                    , "RmOneParameter/A1.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/D1.expected.hs"+                                 "./RmOneParameter/D1.refactored.hs"+      diffD `shouldBe` []++      diffA <- ct $ compareFiles "./RmOneParameter/A1.expected.hs"+                                 "./RmOneParameter/A1.refactored.hs"+      diffA `shouldBe` []++    -- -------------------++    it "rmOneParameter in D2 A2" $ do+          -- (["D2.hs","A2.hs"],["7","19"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/D2.hs" (7,19)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/D2.hs" (7,19)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/D2.hs"+                    , "RmOneParameter/A2.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/D2.expected.hs"+                                 "./RmOneParameter/D2.refactored.hs"+      diffD `shouldBe` []++      diffA <- ct $ compareFiles "./RmOneParameter/A2.expected.hs"+                                 "./RmOneParameter/A2.refactored.hs"+      diffA `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn1" $ do+          -- (["FunIn1.hs"],["8","5"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn1.hs" (8,5)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn1.hs" (8,5)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn1.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn1.expected.hs"+                                 "./RmOneParameter/FunIn1.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn2" $ do+          -- (["FunIn2.hs"],["8","5"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn2.hs" (8,5)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn2.hs" (8,5)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn2.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn2.expected.hs"+                                 "./RmOneParameter/FunIn2.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn2a" $ do+          -- (["FunIn2.hs"],["8","5"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn2a.hs" (8,5)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn2a.hs" (8,5)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn2a.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn2a.expected.hs"+                                 "./RmOneParameter/FunIn2a.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn3" $ do+          -- (["FunIn3.hs"],["7","5"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn3.hs" (7,5)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn3.hs" (7,5)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn3.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn3.expected.hs"+                                 "./RmOneParameter/FunIn3.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn5" $ do+          -- (["FunIn5.hs"],["7","6"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn5.hs" (7,6)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn5.hs" (7,6)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn5.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn5.expected.hs"+                                 "./RmOneParameter/FunIn5.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn6" $ do+          -- (["FunIn6.hs"],["7","5"]),+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn6.hs" (7,5)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn6.hs" (7,5)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn6.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn6.expected.hs"+                                 "./RmOneParameter/FunIn6.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in FunIn0" $ do+          -- (["FunIn0.hs"],["10","7"])],+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn0.hs" (10,7)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn0.hs" (10,7)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/FunIn0.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/FunIn0.expected.hs"+                                 "./RmOneParameter/FunIn0.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in SubFun1" $ do+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/SubFun1.hs" (10,9)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/SubFun1.hs" (10,9)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/SubFun1.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/SubFun1.expected.hs"+                                 "./RmOneParameter/SubFun1.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in SubFun2" $ do+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/SubFun2.hs" (10,9)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/SubFun2.hs" (10,9)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/SubFun2.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/SubFun2.expected.hs"+                                 "./RmOneParameter/SubFun2.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in SubFun3" $ do+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/SubFun3.hs" (10,9)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/SubFun3.hs" (10,9)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/SubFun3.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/SubFun3.expected.hs"+                                 "./RmOneParameter/SubFun3.refactored.hs"+      diffD `shouldBe` []++    -- -------------------++    it "rmOneParameter in MultiFun1" $ do+      r <- ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/MultiFun1.hs" (10,8)+      -- r <- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/MultiFun1.hs" (10,8)++      r' <- ct $ mapM makeRelativeToCurrentDirectory r++      r' `shouldBe` [ "RmOneParameter/MultiFun1.hs"+                    ]++      diffD <- ct $ compareFiles "./RmOneParameter/MultiFun1.expected.hs"+                                 "./RmOneParameter/MultiFun1.refactored.hs"+      diffD `shouldBe` []++    -- ---------------------------------+    -- Negative tests+    -- ---------------------------------++    it "fails FunIn4" $ do+     -- (["FunIn4.hs"],["7","6"]),+     res <- catchException (ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn4.hs" (7,6))+     -- ct $ rmOneParameter logTestSettings testOptions "./RmOneParameter/FunIn4.hs" (7,6)+     (show res) `shouldBe` "Just \"This parameter can not be removed, as it is used!\""++    -- -------------------++    it "fails FunIn7" $ do+          -- (["FunIn7.hs"],["10","4"])]+     res <- catchException (ct $ rmOneParameter defaultTestSettings testOptions "./RmOneParameter/FunIn7.hs" (10,4))+     (show res) `shouldBe` "Just \"Invalid cursor position!\""++    -- -------------------+{-+TestCases{refactorCmd="rmOneParameter",+positive=[+          (["D1.hs","A1.hs"],["6","19"]),+          (["D2.hs","A2.hs"],["7","19"]),+          (["FunIn1.hs"],["8","5"]),+          (["FunIn2.hs"],["8","5"]),+          (["FunIn3.hs"],["7","5"]),+          (["FunIn5.hs"],["7","6"]),+          (["FunIn6.hs"],["7","5"]),+          (["FunIn0.hs"],["10","7"])],+negative=[(["FunIn4.hs"],["7","6"]),+          (["FunIn7.hs"],["10","4"])]+}++TODO: Add a test for a PatBind too+-}

test/GhcUtilsSpec.hs view

@@ -1,25 +1,26 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-} module GhcUtilsSpec (main, spec) where  import           Test.Hspec -import           TestUtils+-- import           TestUtils -import qualified GHC     as GHC+-- import qualified GHC     as GHC -import qualified Data.Generics as SYB-import qualified GHC.SYB.Utils as SYB+-- import qualified Data.Generics as SYB+-- import qualified GHC.SYB.Utils as SYB -import Language.Haskell.GHC.ExactPrint.Utils+-- import Language.Haskell.GHC.ExactPrint.Utils -import Language.Haskell.Refact.Utils.Binds-import Language.Haskell.Refact.Utils.GhcUtils-import Language.Haskell.Refact.Utils.GhcVersionSpecific-import Language.Haskell.Refact.Utils.Monad-import Language.Haskell.Refact.Utils.MonadFunctions-import Language.Haskell.Refact.Utils.TypeUtils-import Language.Haskell.Refact.Utils.Utils-import Language.Haskell.Refact.Utils.Variables+-- import Language.Haskell.Refact.Utils.Binds+-- import Language.Haskell.Refact.Utils.GhcUtils+-- import Language.Haskell.Refact.Utils.GhcVersionSpecific+-- import Language.Haskell.Refact.Utils.Monad+-- import Language.Haskell.Refact.Utils.MonadFunctions+-- import Language.Haskell.Refact.Utils.TypeUtils+-- import Language.Haskell.Refact.Utils.Utils+-- import Language.Haskell.Refact.Utils.Variables  -- import TestUtils @@ -31,7 +32,10 @@  spec :: Spec spec = do-+  describe "nothing happening here" $ do+    it "need to delete this" $ do+      "a" `shouldBe` "a"+  {-   describe "onelayerStaged" $ do     it "only descends one layer into a structure" $ do       let s' = (2,[3,4],5) :: (Int,[Int],Int)@@ -53,12 +57,18 @@         comp = do          parseSourceFileGhc "./DupDef/Dd1.hs"          renamed <- getRefactRenamed+         parsed <- getRefactParsed+         nm <- getRefactNameMap -         let mn = locToName (4,1) renamed-         let (Just (ln@(GHC.L _ n))) = mn+         let mn = locToRdrName (4,1) parsed+         let Just (ln'@(GHC.L l _)) = mn+             n = rdrName2NamePure nm ln'+             ln = GHC.L l n -         let mx = locToName (4,10) renamed-         let (Just (lx@(GHC.L _ x))) = mx+         let mx = locToRdrName (4,10) parsed+         let (Just (lx'@(GHC.L l2 _))) = mx+             x = rdrName2NamePure nm lx'+             lx = GHC.L l2 x           let declsr = hsBinds renamed              duplicatedDecls = definingDeclsNames [n] declsr True False@@ -73,7 +83,11 @@              worker (nn::GHC.Name) = [showGhc nn]              g = onelayerStaged SYB.Renamer ["-1"] (["-10"] `SYB.mkQ` worker) duplicatedDecls +#if __GLASGOW_HASKELL__ <= 710              worker2 ((GHC.L _ (GHC.FunBind (GHC.L _ n') _ _ _ _ _))::GHC.Located (GHC.HsBind GHC.Name))+#else+             worker2 ((GHC.L _ (GHC.FunBind (GHC.L _ n') _ _ _ _))::GHC.Located (GHC.HsBind GHC.Name))+#endif                | n == n' = ["found"]              worker2 _ = []              g2 = onelayerStaged SYB.Renamer ["-1"] (["-10"] `SYB.mkQ` worker2) duplicatedDecls@@ -91,5 +105,6 @@       r2 `shouldBe` True       rx `shouldBe` False       rx2 `shouldBe` True+-}  -- ---------------------------------------------------------------------

test/RenamingSpec.hs view

@@ -291,7 +291,7 @@      it "renames in ConstructorIn3 9 12" $ do      r <- ct $ rename defaultTestSettings testOptions "./Renaming/ConstructorIn3.hs" "b" (9,13)-     -- ct $ rename logTestSettings testOptions Nothing "./Renaming/ConstructorIn3.hs" "b" (9,13)+     -- ct $ rename logTestSettings testOptions "./Renaming/ConstructorIn3.hs" "b" (9,13)      r' <- ct $ mapM makeRelativeToCurrentDirectory r      r' `shouldBe` [ "Renaming/ConstructorIn3.hs"                   ]@@ -366,7 +366,7 @@     -- ---------------------------------      it "naming clash IdIn5" $ do-     -- rename logTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1)+     -- ct $ rename logTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1))      (show res) `shouldBe` "Just \"Name 'y' already exists, or renaming 'IdIn5.x' to 'y' will change the program's semantics!\\n\""

test/TestUtils.hs view

@@ -1,6 +1,5 @@ module TestUtils        ( compareFiles-       , compareStrings        , parsedFileGhc        , parsedFileGhcCd        , parseSourceFileTest@@ -33,16 +32,20 @@        , parseDeclToAnnotated        , ss2span        , PosToken+       , getHsDecls+       , showNameMap        ) where  +import qualified DynFlags      as GHC import qualified FastString    as GHC import qualified GHC           as GHC import qualified Name          as GHC--- import qualified Outputable    as GHC+import qualified Outputable    as GHC import qualified Unique        as GHC  import Data.Algorithm.Diff+import Data.Algorithm.DiffOutput import Data.Data import Exception import Language.Haskell.GHC.ExactPrint@@ -81,18 +84,15 @@  -- --------------------------------------------------------------------- -compareFiles :: FilePath -> FilePath -> IO [Diff [String]]+compareFiles :: FilePath -> FilePath -> IO String compareFiles fileA fileB = do   astr <- readFile fileA   bstr <- readFile fileB-  -- return $ filter (\c -> not( isBoth c)) $ getGroupedDiff (lines astr) (lines bstr)-  return $ compareStrings astr bstr--compareStrings :: String -> String -> [Diff [String]]-compareStrings astr bstr = filter (\c -> not( isBoth c)) $ getGroupedDiff (lines astr) (lines bstr)-    where-      isBoth (Both _ _) = True-      isBoth _        = False+  let+    diffToString ds = case ppDiff ds of+      "\n" -> ""+      s    -> s+  return $ diffToString $ getGroupedDiff (lines astr) (lines bstr)  -- --------------------------------------------------------------------- @@ -245,7 +245,7 @@   return res   where     handler:: SomeException -> IO (Maybe String)-    handler e = return (Just (show e))+    handler e = return (Just (stripCallStack $ show e))  -- --------------------------------------------------------------------- @@ -387,6 +387,23 @@  ss2span :: GHC.SrcSpan -> (Pos,Pos) ss2span ss = (ss2pos ss,ss2posEnd ss)++-- ---------------------------------------------------------------------++-- | call ghc-excactprint hsDecls in a Transform context+getHsDecls :: (HasDecls t) => t -> [GHC.LHsDecl GHC.RdrName]+getHsDecls t = decls+  where+    -- runTransform :: Anns -> Transform a -> (a, (Anns, Int), [String])+    (decls,_,_) = runTransform mempty (hsDecls t)+-- ---------------------------------------------------------------------++showNameMap :: NameMap -> String+showNameMap  nm = GHC.showSDocDebug GHC.unsafeGlobalDynFlags doc+    where+      doc = GHC.text "NameMap" GHC.<+> GHC.vcat (map one $ Map.toList nm)+      -- one (s,n) = GHC.parens $ GHC.text (showGhc (s,n,GHC.nameUnique n)) GHC.<+> GHC.ppr n+      one (s,n) = GHC.parens $ GHC.hsep [GHC.ppr s, GHC.comma, GHC.ppr n]  -- --------------------------------------------------------------------- -- EOF

test/TypeUtilsSpec.hs view

@@ -1,3798 +1,3777 @@-module TypeUtilsSpec (main, spec) where--import           Test.Hspec--import           TestUtils--import qualified GHC.SYB.Utils         as SYB--import qualified GHC        as GHC-import qualified GhcMonad   as GHC-import qualified Name       as GHC-import qualified RdrName    as GHC-import qualified Module     as GHC--import Data.Maybe--import Language.Haskell.GHC.ExactPrint.Types-import Language.Haskell.GHC.ExactPrint.Parsers-import Language.Haskell.GHC.ExactPrint--import Language.Haskell.Refact.Utils.Binds-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.TypeUtils-import Language.Haskell.Refact.Utils.Utils-import Language.Haskell.Refact.Utils.Variables--import qualified Data.Map as Map-import Data.List--main :: IO ()-main = do-  hspec spec--spec :: Spec-spec = do--  -- ---------------------------------------------------------------------  describe "findAllNameOccurences" $ do-   it "finds all occurrences of the given name in a syntax phrase" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/S.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _l n)) = locToName (4,5) renamed-      (showGhcQual n) `shouldBe` "x"--      let res = findAllNameOccurences n renamed-      (showGhcQual res) `shouldBe` "[x, x]"-      -- NOTE: does not get the x's in line 8-      (showGhcQual $ map startEndLocGhc res) `shouldBe` "[((4, 5), (4, 6)), ((4, 17), (4, 18))]"--  -- ---------------------------------------------------------------------  describe "locToName" $ do-    it "returns a GHC.Name for a given source location, if it falls anywhere in an identifier #1" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (res@(GHC.L l n)) = locToName (7,3) renamed-      showGhcQual l `shouldBe` "TypeUtils/B.hs:7:1-3"-      getLocatedStart res `shouldBe` (7,1)-      showGhcQual n `shouldBe` "TypeUtils.B.foo"--    -- -----------------------------------    it "returns a GHC.Name for a given source location, if it falls anywhere in an identifier #2" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (res@(GHC.L l n)) = locToName (25,8) renamed-      showGhcQual n `shouldBe` "TypeUtils.B.bob"-      showGhcQual l `shouldBe` "TypeUtils/B.hs:25:7-9"-      getLocatedStart res `shouldBe` (25,7)--    -- -----------------------------------    it "returns Nothing for a given source location, if it does not fall in an identifier" $ do-      t <- ct $ parsedFileGhc "TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let res = locToName (7,7) renamed-      (showGhcQual res) `shouldBe` "Nothing"--    -- -----------------------------------    it "gets a short name too" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (res@(GHC.L l n)) = locToName (14,1) renamed-      showGhcQual n `shouldBe` "Demote.WhereIn2.sq"-      showGhcQual l `shouldBe` "Demote/WhereIn2.hs:14:1-2"-      getLocatedStart res `shouldBe` (14,1)--    -- -----------------------------------    it "gets a type variable name" $ do-      t <- ct $ parsedFileGhc "./Renaming/ConstructorIn3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (res@(GHC.L l n)) = locToName (9,12) renamed-      showGhcQual n `shouldBe` "a"-      -- Note: loc does not line up due to multiple matches in FunBind-      showGhcQual l `shouldBe` "Renaming/ConstructorIn3.hs:9:12"-      getLocatedStart res `shouldBe` (9,12)--    -- -----------------------------------    it "gets an instance class name" $ do-      t <- ct $ parsedFileGhc "./Renaming/ClassIn3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (res@(GHC.L l n)) = locToName (16,10) renamed-      showGhcQual n `shouldBe` "GHC.Classes.Eq"-      showGhcQual l `shouldBe` "Renaming/ClassIn3.hs:16:10-11"-      getLocatedStart res `shouldBe` (16,10)--  -- ---------------------------------------------------------------------  describe "locToRdrName" $ do-    it "returns a GHC.RdrName for a given source location, if it falls anywhere in an identifier" $ do-      t <- ct $ parsedFileGhc "./Renaming/D5.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (res@(GHC.L l n)) = locToRdrName (20,1) parsed-      (show $ ss2span l) `shouldBe` "((20,1),(20,11))"-      getLocatedStart res `shouldBe` (20,1)-      showGhcQual n `shouldBe` "sumSquares"--    it "returns a GHC.RdrName for a source location, in a MatchGroup" $ do-      t <- ct $ parsedFileGhc "./LocToName.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (res@(GHC.L l n)) = locToRdrName (24,2) parsed-      showGhcQual n `shouldBe` "sumSquares"-      getLocatedStart res `shouldBe` (24,1)-      showGhcQual l `shouldBe` "LocToName.hs:24:1-10"--  -- ---------------------------------------------------------------------  describe "allNames" $ do-    it "lists all Names" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/S.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let res = allNames renamed-      let res' = map (\(GHC.L l n) -> (showGhcQual $ GHC.nameUnique n,showGhcQual (l, GHC.getSrcSpan n, n))) res--      let res'' = foldl' (\m (k,a) -> Map.insertWith (++) k a m) Map.empty res'--      (sort $ Map.elems res'') `shouldBe`-             ["(TypeUtils/S.hs:10:12, TypeUtils/S.hs:10:8, n)(TypeUtils/S.hs:10:8, TypeUtils/S.hs:10:8, n)"-             ,"(TypeUtils/S.hs:10:14, <no location info>, GHC.Num.+)"-             ,"(TypeUtils/S.hs:10:5-6, TypeUtils/S.hs:10:5-6, zz)(TypeUtils/S.hs:10:5-6, TypeUtils/S.hs:10:5-6, zz)(TypeUtils/S.hs:8:13-14, TypeUtils/S.hs:10:5-6, zz)"-             ,"(TypeUtils/S.hs:4:1-3, TypeUtils/S.hs:4:1-3, TypeUtils.S.foo)(TypeUtils/S.hs:4:1-3, TypeUtils/S.hs:4:1-3, TypeUtils.S.foo)"-             ,"(TypeUtils/S.hs:4:13-15, <no location info>, GHC.Real.odd)"-             ,"(TypeUtils/S.hs:4:17, TypeUtils/S.hs:4:5, x)(TypeUtils/S.hs:4:5, TypeUtils/S.hs:4:5, x)"-             ,"(TypeUtils/S.hs:6:10, TypeUtils/S.hs:6:10, TypeUtils.S.A)"-             ,"(TypeUtils/S.hs:6:14, TypeUtils/S.hs:6:14-21, TypeUtils.S.B)"-             ,"(TypeUtils/S.hs:6:25, TypeUtils/S.hs:6:25, TypeUtils.S.C)"-             ,"(TypeUtils/S.hs:6:6, TypeUtils/S.hs:6:1-25, TypeUtils.S.D)"-             ,"(TypeUtils/S.hs:8:1-7, TypeUtils/S.hs:8:1-7, TypeUtils.S.subdecl)(TypeUtils/S.hs:8:1-7, TypeUtils/S.hs:8:1-7, TypeUtils.S.subdecl)"-             ,"(TypeUtils/S.hs:8:16, TypeUtils/S.hs:8:9, x)(TypeUtils/S.hs:8:9, TypeUtils/S.hs:8:9, x)"-             ]--  -- ---------------------------------------------------------------------  describe "getName" $ do-    it "gets a qualified Name at the top level" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just n = getName "TypeUtils.B.foo'" renamed-      (showGhcQual n) `shouldBe` "TypeUtils.B.foo'"-      (showGhcQual $ GHC.getSrcSpan n) `shouldBe` "TypeUtils/B.hs:14:1-4"--    it "gets any instance of an unqualified Name" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just n = getName "foo" renamed-      (showGhcQual n) `shouldBe` "foo"-      (showGhcQual $ GHC.getSrcSpan n) `shouldBe` "TypeUtils/B.hs:9:15-17"--    it "returns Nothing if the Name is not found" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let res = getName "baz" renamed-      (showGhcQual res) `shouldBe` "Nothing"--  -- ---------------------------------------------------------------------  describe "definingDeclsRdrNames" $ do-    it "returns [] if not found" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let renamed = fromJust $ GHC.tm_renamed_source t-      let nameMap = initRdrNameMap t-      let Just ((GHC.L _ n)) = locToName (16,6) renamed-      let decls = GHC.hsmodDecls $ GHC.unLoc parsed-      let res = definingDeclsRdrNames nameMap [n] decls False False-      showGhcQual res `shouldBe` "[]"--    -- -----------------------------------    it "finds declarations at the top level" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just (GHC.L _ n) = locToName (3,3) renamed-      let decls = GHC.hsmodDecls $ GHC.unLoc parsed-      let res = definingDeclsRdrNames nameMap [n] decls False False-      showGhcQual res `shouldBe` "[toplevel x = c * x]"--    -- -----------------------------------    it "finds declarations not at the top level 1" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn6.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just (GHC.L _ n) = locToName (13,29) renamed-      let decls = GHC.hsmodDecls $ GHC.unLoc parsed-      let res = definingDeclsRdrNames nameMap [n] decls False True-      showGhcQual n `shouldBe` "pow"-      showGhcQual res `shouldBe` "[pow = 2]"--    -- -----------------------------------    it "finds declarations not at the top level 2" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/LetIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just (GHC.L _ n) = locToName (11,22) renamed-      let decls = GHC.hsmodDecls $ GHC.unLoc parsed-      let res = definingDeclsRdrNames nameMap [n] decls False True-      showGhcQual n `shouldBe` "sq"-      showGhcQual res `shouldBe` "[sq 0 = 0\n sq z = z ^ pow]"--    -- -----------------------------------    it "finds in a patbind" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just (GHC.L _ n) = locToName (14,1) renamed-      let decls = GHC.hsmodDecls $ GHC.unLoc parsed-      let res = definingDeclsRdrNames nameMap [n] decls False False-      showGhcQual res `shouldBe` "[tup@(h, t)\n   = head $ zip [1 .. 10] [3 .. ff]\n   where\n       ff :: Int\n       ff = 15]"--    -- -----------------------------------    it "finds recursively in sub-binds" $ do-      {--      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let res = definingDecls [(PN (mkRdrName "zz"))] ds False True-      showGhcQual res `shouldBe` "[zz n = n + 1]" -- TODO: Currently fails, will come back to it-      -}-      pending -- "Currently fails, will come back to it"--    -- -----------------------------------    it "only finds recursively in sub-binds if asked" $ do-      {--      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let res = definingDecls [(PN (mkRdrName "zz"))] ds False False-      showGhcQual res `shouldBe` "[]"-      -}-      pending -- "Convert to definingDeclsNames"--  -- ---------------------------------------------------------------------  describe "definingDeclsNames" $ do-    it "returns [] if not found" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (16,6) renamed-      let res = definingDeclsNames [n] (hsBinds renamed) False False-      showGhcQual res `shouldBe` "[]"--    it "finds declarations at the top level" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (3,3) renamed-      let res = definingDeclsNames [n] (hsBinds renamed) False False-      showGhcQual res `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"---    it "finds in a patbind" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (14,1) renamed-      let res = definingDeclsNames [n] (hsBinds renamed) False False-      showGhcQual res `shouldBe` "[DupDef.Dd1.tup@(DupDef.Dd1.h, DupDef.Dd1.t)\n   = GHC.List.head GHC.Base.$ GHC.List.zip [1 .. 10] [3 .. ff]\n   where\n       ff :: GHC.Types.Int\n       ff = 15]"---    it "finds recursively in sub-binds" $ do-      {--      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let res = definingDecls [(PN (mkRdrName "zz"))] ds False True-      showGhcQual res `shouldBe` "[zz n = n + 1]" -- TODO: Currently fails, will come back to it-      -}-      pending -- "Currently fails, will come back to it"--    it "only finds recursively in sub-binds if asked" $ do-      {--      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let res = definingDecls [(PN (mkRdrName "zz"))] ds False False-      showGhcQual res `shouldBe` "[]"-      -}-      pending -- "Convert to definingDeclsNames"--  -- ---------------------------------------------------------------------  describe "definingSigsRdrNames" $ do-    it "returns [] if not found" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n)) = locToName (21,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.ff"-      let res = definingSigsRdrNames nameMap [n] parsed-      showGhcQual res `shouldBe` "[]"--    -- -----------------------------------    it "finds signatures at the top level" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n)) = locToName (4,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.toplevel"-      let res = definingSigsRdrNames nameMap [n] parsed-      showGhcQual res `shouldBe` "[toplevel :: Integer -> Integer]"--    -- -----------------------------------    it "returns only the single signature where there are others too" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n)) = locToName (7,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.c"-      let res = definingSigsRdrNames nameMap [n] parsed-      showGhcQual res `shouldBe`  "[c :: Integer]"--    -- -----------------------------------    it "finds signatures at lower levels" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n)) = locToName (16,5) renamed-      showGhcQual n `shouldBe` "ff"-      let res = definingSigsRdrNames nameMap [n] parsed-      showGhcQual res `shouldBe` "[ff :: Int]"--    -- -----------------------------------    it "finds multiple signatures 1" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n1)) = locToName (21,1) renamed-      showGhcQual n1 `shouldBe` "DupDef.Dd1.ff"--      let Just ((GHC.L _ n2)) = locToName (16,5) renamed-      showGhcQual n2 `shouldBe` "ff"--      let Just ((GHC.L _ n3)) = locToName (4,1) renamed-      showGhcQual n3 `shouldBe` "DupDef.Dd1.toplevel"--      let res = definingSigsRdrNames nameMap [n1,n2,n3] parsed-      showGhcQual res `shouldBe` "[toplevel :: Integer -> Integer, ff :: Int]"--    -- -----------------------------------    it "finds multiple signatures 2" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let nameMap = initRdrNameMap t--      let Just ((GHC.L _ n1)) = locToName (14,1) renamed-      showGhcQual n1 `shouldBe` "DupDef.Dd1.tup"--      let Just ((GHC.L _ n2)) = locToName (14,6) renamed-      showGhcQual n2 `shouldBe` "DupDef.Dd1.h"--      let Just ((GHC.L _ n3)) = locToName (14,8) renamed-      showGhcQual n3 `shouldBe` "DupDef.Dd1.t"--      let res = definingSigsRdrNames nameMap [n1,n2,n3] parsed-      showGhcQual res `shouldBe` "[tup :: (Int, Int), h :: Int, t :: Int]"--  -- ---------------------------------------------------------------------  describe "definingSigsNames" $ do-    it "returns [] if not found" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (21,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.ff"-      let res = definingSigsNames [n] renamed-      showGhcQual res `shouldBe` "[]"--    it "finds signatures at the top level" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (4,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.toplevel"-      let res = definingSigsNames [n] renamed-      showGhcQual res `shouldBe` "[DupDef.Dd1.toplevel ::\n   GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer]"--    it "returns only the single signature where there are others too" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (7,1) renamed-      showGhcQual n `shouldBe` "DupDef.Dd1.c"-      let res = definingSigsNames [n] renamed-      showGhcQual res `shouldBe`  "[DupDef.Dd1.c :: GHC.Integer.Type.Integer]"--    it "finds signatures at lower levels" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (16,5) renamed-      showGhcQual n `shouldBe` "ff"-      let res = definingSigsNames [n] renamed-      showGhcQual res `shouldBe` "[ff :: GHC.Types.Int]"--    it "finds multiple signatures" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n1)) = locToName (21,1) renamed-      showGhcQual n1 `shouldBe` "DupDef.Dd1.ff"--      let Just ((GHC.L _ n2)) = locToName (16,5) renamed-      showGhcQual n2 `shouldBe` "ff"--      let Just ((GHC.L _ n3)) = locToName (4,1) renamed-      showGhcQual n3 `shouldBe` "DupDef.Dd1.toplevel"--      let res = definingSigsNames [n1,n2,n3] renamed-      showGhcQual res `shouldBe` "[ff :: GHC.Types.Int,\n DupDef.Dd1.toplevel ::\n   GHC.Integer.Type.Integer -> GHC.Integer.Type.Integer]"---  -- ---------------------------------------------------------------------  describe "definingTyClDeclsNames" $ do-    it "returns [] if not found" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just ((GHC.L _ n)) = locToName (10,29) renamed-      let res = definingTyClDeclsNames [n] renamed-      showGhcQual res `shouldBe` "[]"--    -- -----------------------------------    it "finds foreign type declarations" $ do-      pending--    -- -----------------------------------    it "finds family declarations" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (7,14) renamed-      let res = definingTyClDeclsNames [n] renamed-      showGhcQual res `shouldBe` "[data family TypeUtils.TyClDEcls.XList a]"--    -- -----------------------------------    it "finds data declarations" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (12,6) renamed-      let res = definingTyClDeclsNames [n] renamed-      (unspace $ showGhcQual res) `shouldBe` "[data TypeUtils.TyClDEcls.Foo\n = TypeUtils.TyClDEcls.Foo GHC.Types.Int]"--    -- -----------------------------------    it "finds type declarations" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (14,6) renamed-      let res = definingTyClDeclsNames [n] renamed-      showGhcQual res `shouldBe` "[type TypeUtils.TyClDEcls.Foo2 = GHC.Base.String]"--    -- -----------------------------------    it "finds class declarations" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (16,7) renamed-      let res = definingTyClDeclsNames [n] renamed-      showGhcQual res `shouldBe` "[class TypeUtils.TyClDEcls.Bar a where\n   TypeUtils.TyClDEcls.bar :: a -> GHC.Types.Bool]"--    -- -----------------------------------    it "finds multiple declarations" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n1) = locToName (14,6) renamed-      let Just (GHC.L _ n2) = locToName (16,7) renamed-      let res = definingTyClDeclsNames [n1,n2] renamed-      showGhcQual res `shouldBe`-            "[type TypeUtils.TyClDEcls.Foo2 = GHC.Base.String,\n"++-            " class TypeUtils.TyClDEcls.Bar a where\n"++-            "   TypeUtils.TyClDEcls.bar :: a -> GHC.Types.Bool]"---  -- ---------------------------------------------------------------------  describe "isFunBindR" $ do-    it "Returns False if not a function definition" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tup = getName "DupDef.Dd1.tup" renamed-      let [decl] = definingDeclsNames [tup] (hsBinds renamed) False False-      isFunBindR decl  `shouldBe` False--    it "Returns True if a function definition" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let (GHC.L _l (GHC.HsModule _name _exps _imps _ds _ _)) = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just toplevel = getName "DupDef.Dd1.toplevel" renamed-      let [decl] = definingDeclsNames [toplevel] (hsBinds renamed) False False-      isFunBindR decl  `shouldBe` True--  -- ---------------------------------------------------------------------  describe "isFunOrPatName" $ do-    it "Return True if a PName is a function/pattern name defined in t" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tup = getName "DupDef.Dd1.tup" renamed-      isFunOrPatName tup renamed  `shouldBe` True--    it "Return False if a PName is a function/pattern name defined in t" $ do-      t  <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      t2 <- ct $ parsedFileGhc "./DupDef/Dd2.hs"-      let renamed  = fromJust $ GHC.tm_renamed_source t-      let renamed2 = fromJust $ GHC.tm_renamed_source t2--      let Just tup = getName "DupDef.Dd1.tup" renamed-      isFunOrPatName tup renamed2  `shouldBe` False---  -- ---------------------------------------------------------------------  describe "hsFreeAndDeclaredXXXX" $ do--    it "finds declared in type class definitions" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareTypes.hs"--      let-        comp = do-          parsed <- getRefactParsed-          decls <- liftT $ hsDecls parsed-          tdss <- mapM getDeclaredTypesRdr decls-          let tds = nub $ concat tdss-          return (tds)-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (res)) `shouldBe`-          "[(FreeAndDeclared.DeclareTypes.XList, (8, 1)),\n"++-          " (FreeAndDeclared.DeclareTypes.X, (19, 1)),\n"++-          " (FreeAndDeclared.DeclareTypes.Y, (19, 10)),\n"++-          " (FreeAndDeclared.DeclareTypes.Z, (19, 22)),\n"++-          " (FreeAndDeclared.DeclareTypes.W, (19, 26)),\n"++-          " (FreeAndDeclared.DeclareTypes.Foo, (21, 1)),\n"++-          " (FreeAndDeclared.DeclareTypes.Bar, (23, 1)),\n"++-          " (FreeAndDeclared.DeclareTypes.doBar, (27, 3)),\n"++-          " (FreeAndDeclared.DeclareTypes.BarVar, (24, 3)),\n"++-          " (FreeAndDeclared.DeclareTypes.BarData, (25, 3))]"--    -- -----------------------------------    it "finds declared HsVar" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let-        comp = do-          parsed <- getRefactParsed-          nm <- getRefactNameMap-          let rr = hsFreeAndDeclaredRdr nm parsed-          let r = hsFreeAndDeclaredPNsOld renamed-          rg <- hsFreeAndDeclaredPNs renamed-          return (r,rg,rr)-      -- ((res,resg,rrr),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((res,resg,(FN fr,DN dr)),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      -- (showGhcQual _fff) `shouldBe` ""--      -- ----------------------      -- Free Vars - renamed-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`-                   "[(Data.Generics.Text.gshow, (-1, -1)),\n "++-                   "(System.IO.getChar, (-1, -1)), "++-                   "(System.IO.putStrLn, (-1, -1)),\n "++-                   "(GHC.Base.return, (-1, -1)), "++-                   "(GHC.Base.$, (-1, -1)),\n "++-                   "(GHC.List.head, (-1, -1)), "++-                   "(GHC.List.zip, (-1, -1)),\n "++-                   "(GHC.Num.fromInteger, (-1, -1)), "++-                   "(GHC.Num.*, (-1, -1))]"--      -- Declared Vars - renamed-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`-                   "[(FreeAndDeclared.Declare.ff, (36, 1)),\n "++-                   "(FreeAndDeclared.Declare.mkT, (34, 1)),\n "++-                   "(FreeAndDeclared.Declare.main, (30, 1)),\n "++-                   "(FreeAndDeclared.Declare.unF, (27, 1)),\n "++-                   "(FreeAndDeclared.Declare.unD, (21, 1)),\n "++-                   "(FreeAndDeclared.Declare.tup, (16, 1)),\n "++ -- ++AZ++ addition-                   "(FreeAndDeclared.Declare.h, (16, 6)),\n "++-                   "(FreeAndDeclared.Declare.t, (16, 8)),\n "++-                   "(FreeAndDeclared.Declare.d, (10, 1)),\n "++-                   "(FreeAndDeclared.Declare.c, (9, 1)),\n "++-                   "(FreeAndDeclared.Declare.toplevel, (6, 1))]"--      -- ----------------------      -- Free Vars - parsed-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) fr) `shouldBe`-                   "[(GHC.Num.*, (-1, -1)), "++-                   "(GHC.Base.$, (-1, -1)),\n "++-                   "(GHC.List.head, (-1, -1)), "++-                   "(GHC.List.zip, (-1, -1)),\n "++-                   "(System.IO.getChar, (-1, -1)), "++-                   "(System.IO.putStrLn, (-1, -1)),\n "++-                   "(Data.Generics.Text.gshow, (-1, -1))]"--      -- Declared Vars - parsed-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) dr) `shouldBe`-                   "[(FreeAndDeclared.Declare.toplevel, (6, 1)),\n "++-                   "(FreeAndDeclared.Declare.c, (9, 1)),\n "++-                   "(FreeAndDeclared.Declare.d, (10, 1)),\n "++-                   "(FreeAndDeclared.Declare.tup, (16, 1)),\n "++-                   "(FreeAndDeclared.Declare.h, (16, 6)),\n "++-                   "(FreeAndDeclared.Declare.t, (16, 8)),\n "++-                   "(FreeAndDeclared.Declare.unD, (21, 1)),\n "++-                   "(FreeAndDeclared.Declare.unF, (27, 1)),\n "++-                   "(FreeAndDeclared.Declare.main, (30, 1)),\n "++-                   "(FreeAndDeclared.Declare.mkT, (34, 1)),\n "++-                   "(FreeAndDeclared.Declare.ff, (36, 1))]"--      -- ----------------------      -- GHC version-      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`-                   "[(Data.Generics.Text.gshow, (-1, -1)),\n "++-                   "(System.IO.getChar, (-1, -1)), "++-                   "(System.IO.putStrLn, (-1, -1)),\n "++-                   "(GHC.List.head, (-1, -1)), "++-                   "(GHC.Base.$, (-1, -1)),\n "++-                   "(GHC.List.zip, (-1, -1)), "++-                   "(GHC.Num.*, (-1, -1))]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`-                   "[(FreeAndDeclared.Declare.ff, (36, 1)),\n "++-                   "(FreeAndDeclared.Declare.mkT, (34, 1)),\n "++-                   "(FreeAndDeclared.Declare.main, (30, 1)),\n "++-                   "(FreeAndDeclared.Declare.unF, (27, 1)),\n "++-                   "(FreeAndDeclared.Declare.unD, (21, 1)),\n "++-                   "(FreeAndDeclared.Declare.tup, (16, 1)),\n "++ -- ++AZ++ not found by old-                   "(FreeAndDeclared.Declare.h, (16, 6)),\n "++-                   "(FreeAndDeclared.Declare.t, (16, 8)),\n "++-                   "(FreeAndDeclared.Declare.d, (10, 1)),\n "++-                   "(FreeAndDeclared.Declare.c, (9, 1)),\n "++-                   "(FreeAndDeclared.Declare.toplevel, (6, 1)),\n "++-                   "(GHC.Types.Int, (-1, -1)), (GHC.Integer.Type.Integer, (-1, -1)),\n "++-                   "(FreeAndDeclared.Declare.D, (18, 1)),\n "++-                   "(FreeAndDeclared.Declare.A, (18, 10)),\n "++-                   "(FreeAndDeclared.Declare.B, (18, 14)),\n "++-                   "(FreeAndDeclared.Declare.C, (18, 25)),\n "++-                   "(FreeAndDeclared.Declare.F, (25, 1)),\n "++-                   "(FreeAndDeclared.Declare.G, (25, 10)),\n "++-                   "(FreeAndDeclared.Declare.:|, (25, 14))]"--    -- -----------------------------------    it "finds free and declared in a single bind PrefixCon" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let-        comp = do-          let b = head $ drop 4 $ hsBinds renamed-          rg <- hsFreeAndDeclaredPNs [b]-          return (b,rg)-      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions---      (showGhcQual bb) `shouldBe` "FreeAndDeclared.Declare.unD (FreeAndDeclared.Declare.B y) = y"-      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""--      -- GHC version-      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`-                   "[(FreeAndDeclared.Declare.B, (18, 14))]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`-                   "[(FreeAndDeclared.Declare.unD, (21, 1))]"--    -- -----------------------------------    it "finds free and declared in a single bind InfixCon" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let-        comp = do-          let b = head $ drop 3 $ hsBinds renamed-          rg <- hsFreeAndDeclaredPNs [b]-          return (b,rg)-      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual bb) `shouldBe` "FreeAndDeclared.Declare.unF (a FreeAndDeclared.Declare.:| b)\n  = (a, b)"-      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""--      -- GHC version-      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`-                   "[(FreeAndDeclared.Declare.:|, (25, 14))]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`-                   "[(FreeAndDeclared.Declare.unF, (27, 1))]"--    -- -----------------------------------    it "finds free and declared in a single bind RecCon" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareRec.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let-        comp = do-          let b = head $ drop 0 $ hsBinds renamed-          rg <- hsFreeAndDeclaredPNs [b]-          return (b,rg)-      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions---      (showGhcQual bb) `shouldBe` "FreeAndDeclared.DeclareRec.unR2\n  (FreeAndDeclared.DeclareRec.RCon {FreeAndDeclared.DeclareRec.r1 = a})\n  = a"-      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""--      -- GHC version-      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`-                   "[(FreeAndDeclared.DeclareRec.RCon, (3, 10))]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`-                   "[(FreeAndDeclared.DeclareRec.unR2, (7, 1))]"--    -- -------------------------------------------------------------------    it "hsFreeAndDeclaredPNs simplest" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareS.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let-        comp = do-          r <- hsFreeAndDeclaredPNs renamed-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe` "[]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe` "[(FreeAndDeclared.DeclareS.c, (6, 1))]"--    -- -------------------------------------------------------------------    it "finds free and declared in a single bind #2" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tup = getName "DupDef.Dd1.ff" renamed-      let [decl] = definingDeclsNames [tup] (hsBinds renamed) False False--      let-        comp = do-          r <- hsFreeAndDeclaredPNs [decl]-          return (r,decl)-      ((res,d),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual d) `shouldBe` "DupDef.Dd1.ff y\n  = y GHC.Num.+ zz\n  where\n      zz = 1"-      -- (SYB.showData SYB.Renamer 0 d) `shouldBe` ""--      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`-                   "[(GHC.Num.+, (-1, -1))]"--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`-                   "[(DupDef.Dd1.ff, (21, 1))]"--    -- -------------------------------------------------------------------    it "finds free and declared at the top level 1" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let-        comp = do-          r <- hsFreeAndDeclaredPNs $ hsBinds renamed-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`-                   "[(LiftToToplevel.WhereIn1.anotherFun, (15, 1)),\n "++-                   "(LiftToToplevel.WhereIn1.sumSquares, (9, 1))]"--      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`-                   "[(GHC.Real.^, (-1, -1)), (GHC.Num.+, (-1, -1))]"--    -- -------------------------------------------------------------------    it "finds free and declared at the top level 2" $ do-      t <- ct $ parsedFileGhc "./Renaming/IdIn3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let-        comp = do-          r <- hsFreeAndDeclaredPNs renamed-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`-                   "[(IdIn3.bar, (14, 1))"++-                  ", (IdIn3.x, (10, 1))"++-                  ", (IdIn3.foo, (12, 1)),\n "++-                    "(IdIn3.main, (18, 1))]"---      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`-                   "[(GHC.Num.+, (-1, -1))]"--    -- -------------------------------------------------------------------    it "finds free and declared in a GRHSs" $ do-      t <- ct $ parsedFileGhc "./LiftOneLevel/LetIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tup = getName "LiftOneLevel.LetIn2.sumSquares" renamed-      let [decl] = definingDeclsNames [tup] (hsBinds renamed) False False--      let (GHC.L _ (GHC.FunBind _ _ (GHC.MG [match] _ _ _) _ _ _)) = decl-      let (GHC.L _ (GHC.Match _ _pat _ grhss)) = match--      let-        comp = do-          r <- hsFreeAndDeclaredPNs grhss-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions---      -- Declared Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`-                   "[]"--      -- Free Vars-      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`-                   "[(GHC.Real.^, (-1, -1)), (x, (10, 12)), (GHC.Num.+, (-1, -1)),\n (y, (10, 14))]"--    -- -------------------------------------------------------------------    it "finds free and declared in a single bind" $ do-      pending -- "fix the prior test"--  -- ------------------------------------------------------------------------  describe "hsFDsFromInsideRdr" $ do-    it "does something useful" $ do-      pending -- "Complete this"--  describe "hsFDsFromInside" $ do-    it "does something useful" $ do-      pending -- "Complete this"--  describe "hsFDNamesFromInside" $ do-    it "does something useful" $ do-      pending -- "Complete this"--  -- -----------------------------------------------------------------------  describe "hsVisibleNames" $ do-    it "does something useful" $ do-      pending -- "Complete this"--  -- -----------------------------------------------------------------------  describe "hsVisiblePNs" $ do--    -- -----------------------------------    it "returns [] if e does not occur in t" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tl1  = locToExp (4,13) (4,40) renamed :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-      let Just tup = getName "DupDef.Dd1.tup" renamed-      let-        comp = do-          r <- hsVisiblePNs tup tl1-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual $ res) `shouldBe` "[]"--    -- -------------------------------------------------------------------    it "returns visible vars if e does occur in t #1" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tl1  = locToExp (28,4) (28,12) renamed :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-      (showGhcQual tl1) `shouldBe` "ll GHC.Num.+ z"--      let Just tup = getName "DupDef.Dd1.l" renamed-      let [decl] = definingDeclsNames [tup] (hsBinds renamed) False False-      (showGhcQual decl) `shouldBe` "DupDef.Dd1.l z = let ll = 34 in ll GHC.Num.+ z"--      let-        comp = do-         r <- hsVisiblePNs tl1 decl-         return (r)-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual res ) `shouldBe` "[z, ll]"-      -- (showGhcQual res2 ) `shouldBe` "[z, ll]"--    -- -------------------------------------------------------------------    it "returns visible vars if e does occur in t #2" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just tl1  = locToExp (28,4) (28,12) renamed :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-      (showGhcQual tl1) `shouldBe` "ll GHC.Num.+ z"--      let Just rhs  = locToExp (26,1) (28,12) renamed :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-      (showGhcQual rhs) `shouldBe` "let ll = 34 in ll GHC.Num.+ z"--      let-        comp = do-          r <- hsVisiblePNs tl1 rhs-          return r-      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual res) `shouldBe` "[ll]"--    -- -------------------------------------------------------------------{--    it "returns visible vars if e does occur in t #3" $ do-      (t,toks) <- ct $ parsedFileGhc "./TypeUtils/VisiblePNs.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let-        comp = do-          renamed <- getRefactRenamed-          let Just tl1  = locToName (41,11) renamed  --  :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-          r <- hsVisiblePNs tl1 renamed-          -- let r = hsVisiblePNsGhc tl1 renamed-          let fvs = map (\b -> (showGhcQual b,getFreeVars [b])) (hsBinds renamed)-          let dvs = getDeclaredVars $ hsBinds renamed-          return (tl1,r,fvs,dvs)-      -- ((tl,res,_f,d),_s) <- runRefactGhc comp $ initialState { rsModule = initRefactModule [] t }-      ((tl,res,_f,d),_s) <- runRefactGhc comp $ initialLogOnState { rsModule = initRefactModule [] t }--      (showGhcQual tl) `shouldBe` "modu"-      -- (showGhcQual f) `shouldBe` ""-      (showGhcQual d) `shouldBe`-           "[TypeUtils.VisiblePNs.parsedFileGhc,\n"++-           " TypeUtils.VisiblePNs.parsedFileBGhc,\n"++-           " TypeUtils.VisiblePNs.runRefactGhcState,"++-           " TypeUtils.VisiblePNs.zz,\n"++-           " TypeUtils.VisiblePNs.yy,"++-           " TypeUtils.VisiblePNs.xx,\n"++-           " TypeUtils.VisiblePNs.ww,"++-           " TypeUtils.VisiblePNs.spec,\n"++-           " TypeUtils.VisiblePNs.main]"-      (showGhcQual res) `shouldBe`-           "[TypeUtils.VisiblePNs.parsedFileGhc,\n"++-           " TypeUtils.VisiblePNs.parsedFileBGhc,\n"++-           " TypeUtils.VisiblePNs.runRefactGhcState,"++-           " TypeUtils.VisiblePNs.zz,\n"++-           " TypeUtils.VisiblePNs.yy,"++-           " TypeUtils.VisiblePNs.xx,\n"++-           " TypeUtils.VisiblePNs.ww,"++-           " TypeUtils.VisiblePNs.spec,\n"++-           " TypeUtils.VisiblePNs.main,"++-           " modu,"++-           " t,"++-           " _toks,"++-           " expr]"--}--  -- -----------------------------------------------------------------------  describe "hsVisibleDsRdr" $ do-    it "Rdr:finds function arguments visible in RHS 1" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just e  = locToExp (5,11) (5,19) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))-      (showGhcQual e) `shouldBe` "a + b"--      let Just n = getName "Visible.Simple.params" renamed--      let-        comp = do-          nameMap <- getRefactNameMap-          declsp <- liftT $ hsDecls parsed-          let [decl] = definingDeclsRdrNames nameMap [n] declsp False False-          fds' <- hsVisibleDsRdr nameMap e decl-          return (fds')-      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "DN [a, b, GHC.Num.+]"--    -- -------------------------------------    it "Rdr:finds function arguments visible in RHS 2" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let Just e   = locToExp (9,15) (9,17) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))-      (showGhcQual e) `shouldBe` "x"--      let Just n = getName "Visible.Simple.param2" renamed--      let-        comp = do-          nameMap <- getRefactNameMap-          declsp <- liftT $ hsDecls parsed-          let [decl] = definingDeclsRdrNames nameMap [n] declsp False False-          fds' <- hsVisibleDsRdr nameMap e decl-          return (fds')-      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "DN [x]"---    -- -------------------------------------    it "Rdr:finds visible vars inside a function" $ do-      t <- ct $ parsedFileGhc "./Renaming/IdIn5.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just rhsr = locToExp (14,6) (15,14) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      let Just rhs  = locToExp (14,6) (15,14) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))-      (showGhcQual rhs) `shouldBe` "x + y + z"--      -- let Just er = getName "IdIn5.x" renamed-      let Just e  = locToRdrName (14,7) parsed-      (showGhcQual e) `shouldBe` "x"-      (SYB.showData SYB.Parser 0 e) `shouldBe` "\n(L {Renaming/IdIn5.hs:14:7} \n (Unqual {OccName: x}))"--      let-        comp = do-          nameMap <- getRefactNameMap-          fds' <- hsVisibleDsRdr nameMap e rhs-          ffds <- hsFreeAndDeclaredGhc rhsr-          return (fds',ffds)-      -- ((fds,_fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show _fds) `shouldBe` "(FN [IdIn5.x, GHC.Num.+, y, z],DN [])"-      (show fds)  `shouldBe` "DN [GHC.Num.+, IdIn5.x, y, z]"--    -- -------------------------------------    it "Rdr:finds visible vars inside a data declaration" $ do-      t <- ct $ parsedFileGhc "./Renaming/D1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just ln = locToRdrName (6, 6) parsed-      (showGhcQual ln) `shouldBe` "Tree"-      (SYB.showData SYB.Parser 0 ln) `shouldBe` "\n(L {Renaming/D1.hs:6:6-9} \n (Unqual {OccName: Tree}))"--      let-        comp = do-          nameMap <- getRefactNameMap-          fds' <- hsVisibleDsRdr nameMap ln parsed-          ffds <- hsFreeAndDeclaredGhc renamed-          return (fds',ffds)-      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((fds,_fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (show _fds) `shouldBe` "(FN [:, GHC.Num.+, GHC.Real.^, [], GHC.Base.++],"++-                              "DN [Renaming.D1.sumSquares, Renaming.D1.fringe, Renaming.D1.Tree, a,\n"++-                              " Renaming.D1.Leaf, Renaming.D1.Branch, Renaming.D1.SameOrNot,\n"++-                              " Renaming.D1.isSame, Renaming.D1.isNotSame])"-      (show fds) `shouldBe` "DN [Renaming.D1.Tree, Renaming.D1.Leaf, Renaming.D1.Branch]"---  -- -----------------------------------------------------------------------  describe "hsVisibleDs" $ do-    it "finds function arguments visible in RHS 1" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let Just e  = locToExp (5,11) (5,19) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      (showGhcQual e) `shouldBe` "a GHC.Num.+ b"--      let Just n = getName "Visible.Simple.params" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False--      let binds = hsValBinds [decl]--      let-        comp = do-          fds' <- hsVisibleDs e $  head $ hsBinds binds-          return (fds')-      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "DN [a, b, GHC.Num.+]"--    -- -------------------------------------    it "finds function arguments visible in RHS 2" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just e  = locToExp (9,15) (9,17) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      (showGhcQual e) `shouldBe` "x"--      let Just n = getName "Visible.Simple.param2" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False--      let binds = hsValBinds [decl]--      let-        comp = do-          fds' <- hsVisibleDs e $  head $ hsBinds binds-          return (fds')-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "DN [x]"---    -- -------------------------------------    it "finds visible vars inside a function" $ do-      t <- ct $ parsedFileGhc "./Renaming/IdIn5.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just rhs  = locToExp (14,6) (15,14) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      (showGhcQual rhs) `shouldBe` "IdIn5.x GHC.Num.+ y GHC.Num.+ z"--      let Just e = getName "IdIn5.x" renamed--      let-        comp = do-          fds' <- hsVisibleDs e rhs-          ffds <- hsFreeAndDeclaredGhc rhs-          return (fds',ffds)-      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show _fds) `shouldBe` "(FN [IdIn5.x, GHC.Num.+, y, z],DN [])"-      (show fds) `shouldBe` "DN [GHC.Num.+, y, z]"--    -- -------------------------------------    it "finds visible vars inside a data declaration" $ do-      t <- ct $ parsedFileGhc "./Renaming/D1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (6, 6) renamed-      (showGhcQual n) `shouldBe` "Renaming.D1.Tree"--      let-        comp = do-          fds' <- hsVisibleDs n renamed-          ffds <- hsFreeAndDeclaredGhc renamed-          return (fds',ffds)-      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show _fds) `shouldBe` "(FN [:, GHC.Num.+, GHC.Real.^, [], GHC.Base.++],"++-                             "DN [Renaming.D1.sumSquares, Renaming.D1.fringe, Renaming.D1.Tree, a,\n "++-                                 "Renaming.D1.Leaf, Renaming.D1.Branch, Renaming.D1.SameOrNot,\n "++-                                 "Renaming.D1.isSame, Renaming.D1.isNotSame])"-      (show fds) `shouldBe` "DN [Renaming.D1.Tree, Renaming.D1.Leaf, Renaming.D1.Branch]"---  -- -----------------------------------------------------------------------  describe "hsFreeAndDeclaredGhc" $ do-    it "finds function arguments visible in RHS fd" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let Just e  = locToExp (5,11) (5,19) renamed :: (Maybe (GHC.Located (GHC.HsExpr GHC.Name)))-      (showGhcQual e) `shouldBe` "a GHC.Num.+ b"--      let Just n = getName "Visible.Simple.params" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False--      let binds = hsValBinds [decl]--      let-        comp = do-          fds' <- hsFreeAndDeclaredGhc $  head $ hsBinds binds-          return (fds')-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "(FN [GHC.Num.+],DN [Visible.Simple.params])"--    -- -------------------------------------    it "finds function arguments and free vars visible in RHS" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just e  = locToExp (9,15) (9,17) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      (showGhcQual e) `shouldBe` "x"--      let Just n = getName "Visible.Simple.param2" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False--      let binds = hsValBinds [decl]-      let (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = head $ hsBinds binds-      let [(GHC.L _ (GHC.Match _ pats _ _))] = matches-      let lpat = head pats--      let-        comp = do-          fds' <- hsFreeAndDeclaredGhc $ lpat-          return (fds')-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe` "(FN [Visible.Simple.B],DN [x])"--    -- -------------------------------------    it "finds imported functions used in the rhs" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just n = getName "FreeAndDeclared.Declare.tup" renamed-      let decls = definingDeclsNames [n] (hsBinds renamed) False False--      let-        comp = do-          fds' <- hsFreeAndDeclaredGhc $ decls-          return (fds')-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe`-            "(FN [GHC.List.head, GHC.Base.$, GHC.List.zip],"++-            "DN [FreeAndDeclared.Declare.tup, FreeAndDeclared.Declare.h,\n "++-                "FreeAndDeclared.Declare.t])"--    -- -------------------------------------    it "finds free vars in HsWithBndrs" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Binders.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just n = getName "FreeAndDeclared.Binders.findNewPName" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False-      let (GHC.L _ (GHC.FunBind _ _ (GHC.MG [match] _ _ _) _ _ _)) = decl-      let (GHC.L _ (GHC.Match _ _pats _rhs binds)) = match--      let-        comp = do-          fds' <- hsFreeAndDeclaredGhc $ binds-          return (fds')-      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe`-            "(FN [FreeAndDeclared.Binders.gfromJust,"++-            " FreeAndDeclared.Binders.Name,\n"++-            " FreeAndDeclared.Binders.occNameString,"++-            " GHC.Base.$,\n"++-            " FreeAndDeclared.Binders.getOccName,"++-            " GHC.Classes.==,"++-            " name,\n"++-            " GHC.Base.Just,"++-            " GHC.Base.Nothing,\n"++-            " FreeAndDeclared.Binders.somethingStaged,\n"++-            " FreeAndDeclared.Binders.Renamer,"++-            " renamed],"++-            "DN [worker, res])"--    -- -------------------------------------    it "finds free vars in TH files" $ do-      t <- ct $ parsedFileGhc "./TH/Main.hs"-      let-        comp = do-          parseSourceFileGhc "./TH/Main.hs"-          parsed <- getRefactParsed-          nm <- getRefactNameMap-          let fds' = hsFreeAndDeclaredRdr nm parsed-          return (fds')-      ((fds),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (show fds) `shouldBe`-            "(FN [System.IO.putStrLn, pr],"++-             "DN [TH.Main.main, TH.Main.baz, TH.Main.sillyString])"--  -- -----------------------------------------------  describe "getParsedForRenamedLPat" $ do-    it "gets the ParsedSource version of a RenamedSource LPat" $ do-      t <- ct $ parsedFileGhc "./Visible/Simple.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just e  = locToExp (9,15) (9,17) renamed :: (Maybe (GHC.LHsExpr GHC.Name))-      (showGhcQual e) `shouldBe` "x"--      let Just n = getName "Visible.Simple.param2" renamed-      let [decl] = definingDeclsNames [n] (hsBinds renamed) False False--      let binds = hsValBinds [decl]-      let (GHC.L _ (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _)) = head $ hsBinds binds-      let [(GHC.L _ (GHC.Match _ pats _ _))] = matches-      let pat@(GHC.L lp _) = head pats--      let pat' = getParsedForRenamedLPat parsed pat--      let (GHC.L lp' _) = pat'-      lp `shouldBe` lp'--      (SYB.showData SYB.Renamer 0 pat') `shouldBe`-           "\n"++-           "(L {Visible/Simple.hs:9:8-12} \n"++-           " (ParPat \n"++-           "  (L {Visible/Simple.hs:9:9-11} \n"++-           "   (ConPatIn \n"++-           "    (L {Visible/Simple.hs:9:9} \n"++-           "     (Unqual {OccName: B})) \n"++-           "    (PrefixCon \n"++-           "     [\n"++-           "      (L {Visible/Simple.hs:9:11} \n"++-           "       (VarPat \n"++-           "        (Unqual {OccName: x})))])))))"--      (SYB.showData SYB.Renamer 0 pat) `shouldBe`-           "\n"++-           "(L {Visible/Simple.hs:9:8-12} \n"++-           " (ParPat \n"++-           "  (L {Visible/Simple.hs:9:9-11} \n"++-           "   (ConPatIn \n"++-           "    (L {Visible/Simple.hs:9:9} {Name: B}) \n"++-           "    (PrefixCon \n"++-           "     [\n"++-           "      (L {Visible/Simple.hs:9:11} \n"++-           "       (VarPat {Name: x}))])))))"---  -- -----------------------------------------------  describe "isLocalPN" $ do-    it "returns True if the name is local to the module" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n) = locToName (17, 5) renamed-      (showGhcQual n) `shouldBe` "ff"-      isLocalPN n `shouldBe` True--    it "returns False if the name is not local to the module" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n) = locToName (21, 1) renamed-      (showGhcQual n) `shouldBe` "DupDef.Dd1.ff"-      isLocalPN n `shouldBe` False--  -- -----------------------------------------------  describe "isTopLevelPN" $ do-    it "returns False if the name is not defined at the top level of the module" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          let Just (GHC.L _ n) = locToName (17, 5) renamed-          topLevel <- isTopLevelPN n-          return (n,topLevel)-      ((nf,tl),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual nf) `shouldBe` "ff"-      tl `shouldBe` False--    it "returns True if the name is defined at the top level of the module" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          let Just (GHC.L _ n) = locToName (21, 1) renamed-          topLevel <- isTopLevelPN n-          return (n,topLevel)--      ((nf,tl),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual nf) `shouldBe` "DupDef.Dd1.ff"-      tl `shouldBe` True--  -- -----------------------------------------------  describe "definedPNs" $ do-    it "gets the PNs defined in a declaration" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ pn) = locToName (3, 1) renamed-      (showGhcQual pn) `shouldBe` "DupDef.Dd1.toplevel"--      let origDecls = hsBinds renamed-      let demotedDecls'= definingDeclsNames [pn] origDecls True False-      let declaredPns = nub $ concatMap definedPNs demotedDecls'--      (showGhcQual declaredPns) `shouldBe` "[DupDef.Dd1.toplevel]"--    -- -----------------------------------    it "gets the PNs defined in an as-match" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ pn) = locToName (14, 1) renamed-      (showGhcQual pn) `shouldBe` "DupDef.Dd1.tup"--      let origDecls = hsBinds renamed-      let demotedDecls'= definingDeclsNames [pn] origDecls True False-      let declaredPns = nub $ concatMap definedPNs demotedDecls'--      (showGhcQual declaredPns) `shouldBe` "[DupDef.Dd1.tup, DupDef.Dd1.h, DupDef.Dd1.t]"---  -- -----------------------------------------------  describe "inScopeInfo" $ do-    it "returns 4 element tuples for in scope names" $ do-      pending -- "is this still needed?"-      {--      ((inscopes, _renamed, _parsed), _toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let info = inScopeInfo inscopes-      (show $ head info) `shouldBe` "foo"-      -- (show $ info) `shouldBe` "foo"-      -}--  -- -----------------------------------------------  describe "isInScopeAndUnqualified" $ do-    it "True if the identifier is in scope and unqualified" $ do-      pending -- "needed?"-      {--      ((inscopes, _renamed, _parsed), _toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let info = inScopeInfo inscopes-      (show $ head info) `shouldBe` "foo"-      -}--- inScopeInfo for c is--- (\"DupDef.Dd1.c\",VarName,DupDef.Dd1,Nothing)--  -- -----------------------------------------------  describe "isInScopeAndUnqualifiedGhc" $ do-    it "True if the identifier is in scope and unqualified" $ do-      let-        comp = do-         parseSourceFileGhc "./DupDef/Dd1.hs"-         ctx <- GHC.getContext-         res1 <- isInScopeAndUnqualifiedGhc "c" Nothing-         res2 <- isInScopeAndUnqualifiedGhc "DupDef.Dd1.c" Nothing-         res3 <- isInScopeAndUnqualifiedGhc "nonexistent" Nothing-         return (res1,res2,res3,ctx)-      ((r1,r2,r3,_c),_s) <- ct $ runRefactGhc comp (initialState { rsModule = Nothing }) testOptions-      r1 `shouldBe` True-      r2 `shouldBe` True-      r3 `shouldBe` False--    -- -----------------------------------    it "requires qualification on name clash with an import" $ do-      t <- ct $ parsedFileGhc  "./ScopeAndQual.hs"-      let-        comp = do-         parseSourceFileGhc "./ScopeAndQual.hs"-         -- putParsedModule t-         renamed <- getRefactRenamed--         logm $ "renamed=" ++ (SYB.showData SYB.Renamer 0 renamed) -- ++AZ++--         ctx <- GHC.getContext--         let Just sumSquares = locToName (13,15) renamed-         ssUnqual <- isQualifiedPN $ GHC.unLoc sumSquares-         names <- GHC.parseName "sum"-         names2 <- GHC.parseName "mySumSq"-         res1 <- isInScopeAndUnqualifiedGhc "sum" Nothing-         res2 <- isInScopeAndUnqualifiedGhc "L.sum" Nothing-         return (res1,res2,names,names2,sumSquares,ssUnqual,ctx)-      ((r1,r2,ns,ns2,ss,ssu,_c),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (prettyprint ss) `shouldBe` "sumSquares"-      (showGhcQual ss) `shouldBe` "ScopeAndQual.sumSquares"-      (show $ ssu) `shouldBe` "False"-      (showGhcQual ns) `shouldBe` "[ScopeAndQual.sum]"-      (showGhcQual ns2) `shouldBe` "[ScopeAndQual.mySumSq]"-      "1" ++ (show r1) `shouldBe` "1True"-      "2" ++ (show r2) `shouldBe` "2True"--  -- -----------------------------------------------  describe "mkNewGhcName" $ do-    it "Creates a new GHC.Name" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         renamed <- getRefactRenamed-         let Just (GHC.L _ topLevel) = locToName (3,1) renamed--         name1 <- mkNewGhcName Nothing "foo"-         name2 <- mkNewGhcName Nothing "bar"-         name3 <- mkNewGhcName (Just (GHC.nameModule topLevel)) "baz"--         return (name1,name2,name3)-      ((n1,n2,n3),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      GHC.getOccString n1 `shouldBe` "foo"-      showGhcQual n1 `shouldBe` "foo"-      GHC.getOccString n2 `shouldBe` "bar"-      showGhcQual n2 `shouldBe` "bar"-      (showGhcQual $ GHC.nameModule n3) `shouldBe` "main@main:DupDef.Dd1"-      (SYB.showData SYB.Renamer 0 n3) `shouldBe` "{Name: baz}"-      GHC.getOccString n3 `shouldBe` "baz"-      showGhcQual n3 `shouldBe` "DupDef.Dd1.baz"-      (showGhcQual $ GHC.nameUnique n1) `shouldBe` "H2"-      (showGhcQual $ GHC.nameUnique n2) `shouldBe` "H3"-      (showGhcQual $ GHC.nameUnique n3) `shouldBe` "H4"--  -- -----------------------------------------------  describe "prettyprint" $ do-    it "Prints a GHC.Name ready for parsing into tokens" $ do-      -- (_t, _toks, _tgt) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         name1 <- mkNewGhcName Nothing "foo"-         name2 <- mkNewGhcName Nothing "bar"-         return (name1,name2)-      ((n1,n2),_s) <- ct $ runRefactGhcState comp-      GHC.getOccString n1 `shouldBe` "foo"-      showGhcQual n1 `shouldBe` "foo"-      GHC.getOccString n2 `shouldBe` "bar"-      showGhcQual n2 `shouldBe` "bar"-      showGhcQual n1 `shouldBe` "foo"--  -- -----------------------------------------------  describe "duplicateDecl" $ do-    it "duplicates a bind only" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (3, 1) renamed-      let-        comp = do-         parsed <- getRefactParsed-         declsp <- liftT $ hsDecls parsed-         newName2 <- mkNewGhcName Nothing "bar2"-         newBindings <- duplicateDecl declsp n newName2-         parsed' <- liftT $ replaceDecls parsed newBindings-         putRefactParsed parsed' emptyAnns--         return newBindings-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "DupDef.Dd1.toplevel"-      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nbar2 :: Integer -> Integer\nbar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"--  -- -----------------------------------------------    it "duplicates a bind with a signature, and an offset" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just np = locToName (14, 1) renamed-      (showGhcQual np) `shouldBe` "DupDef.Dd1.tup"--      let Just ln@(GHC.L _l n) = locToName (17, 6) renamed-      (showGhcQual n) `shouldBe` "ff"-      let-        comp = do-         newName2 <- mkNewGhcName Nothing "gg"-         nm <- getRefactNameMap--         parsed <- getRefactParsed-         decls <- liftT $ hsDecls parsed--         (front,[parent],back) <- divideDecls decls ln--         (parent',Just (funBinding,declsToDup,declsp')) <- modifyValD (GHC.getLoc parent) parent $ \_m declsp -> do-           let-             declsToDup = definingDeclsRdrNames nm [n] declsp True True-             funBinding = filter isFunOrPatBindP declsToDup     --get the fun binding.--           declsp' <- duplicateDecl declsp n newName2--           return (declsp',Just (funBinding,declsToDup,declsp'))--         parsed' <- liftT $ replaceDecls parsed (front ++ [parent'] ++ back)-         putRefactParsed parsed' emptyAnns--         return (funBinding,declsToDup,declsp')--      ((fb,dd,newb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((fb,dd,newb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "ff"-      (showGhcQual dd) `shouldBe` "[ff = 15]"-      (showGhcQual fb) `shouldBe` "[ff = 15]"-      (show $ getStartEndLoc fb) `shouldBe` "((17,5),(17,12))"-      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\n    gg :: Int\n    gg = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"-      (showGhcQual newb) `shouldBe` "[ff :: Int, ff = 15, gg :: Int, gg = 15]"-      (showGhcQual fb) `shouldBe` "[ff = 15]"---  -- -----------------------------------------------  describe "addParamsToDecl" $ do-    it "adds parameters to a declaration" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (3, 1) renamed-      let-        comp = do-         declsp <- liftT $ hsDecls parsed-         let newName2 = mkRdrName "bar2"-         declsp' <- addParamsToDecls declsp n [newName2]-         parsed' <- liftT $ replaceDecls parsed declsp'-         putRefactParsed parsed' emptyAnns--         return declsp'-      (nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1.toplevel"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel bar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (showGhcQual $ head $ tail nb) `shouldBe` "toplevel bar2 x = c * x"--    -- -----------------------------------    it "adds parameters to a declaration with multiple matches" $ do-      t <- ct $ parsedFileGhc "./AddParams1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (3, 1) renamed-      let-        comp = do-         declsp <- liftT $ hsDecls parsed-         let newName = mkRdrName "pow"-         declsp' <- addParamsToDecls declsp n [newName]-         parsed' <- liftT $ replaceDecls parsed declsp'-         putRefactParsed parsed' emptyAnns-         return declsp'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "AddParams1.sq"-      (sourceFromState s) `shouldBe` "module AddParams1 where\n\nsq pow  0 = 0\nsq pow  z = z^2\n\nfoo = 3\n\n"--    -- -----------------------------------    it "adds parameters to a declaration with no existing ones" $ do-      t <- ct $ parsedFileGhc "./AddParams1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (6, 1) renamed-      let-        comp = do-         declsp <- liftT $ hsDecls parsed-         let newName1 = mkRdrName "baz"-         let newName2 = mkRdrName "bar"-         declsp' <- addParamsToDecls declsp n [newName1,newName2]-         parsed' <- liftT $ replaceDecls parsed declsp'-         putRefactParsed parsed' emptyAnns--         return declsp'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "AddParams1.foo"-      (sourceFromState s) `shouldBe` "module AddParams1 where\n\nsq  0 = 0\nsq  z = z^2\n\nfoo baz bar = 3\n\n"--  -- -----------------------------------------------  describe "addActualParamsToRhs" $ do-    it "adds a parameter to the rhs of a declaration" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/D1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (6, 21) renamed-      let-        comp = do-         parsed <- getRefactParsed-         declsp <- liftT $ hsDecls parsed-         let decl = head declsp-         let newName2 = mkRdrName "bar2"-         newBinding <- addActualParamsToRhs n [newName2] decl--         return (newBinding,decl)-      ((nb,decl'),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,decl'),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual decl') `shouldBe` "sumSquares (x : xs)\n  = sq x + sumSquares xs\n  where\n      sq x = x ^ pow\n      pow = 2\nsumSquares [] = 0"-      (showGhcQual n) `shouldBe` "sq"-      (showGhcQual nb) `shouldBe` "sumSquares (x : xs)\n  = (sq bar2) x + sumSquares xs\n  where\n      sq x = x ^ pow\n      pow = 2\nsumSquares [] = 0"-      (exactPrintFromState s nb) `shouldBe` "\n\n{-lift 'sq' to top level. This refactoring\n  affects module 'D1' and 'C1' -}\n\nsumSquares (x:xs) = (sq bar2) x + sumSquares xs\n  where\n     sq x = x ^ pow\n     pow =2\n\nsumSquares [] = 0"--    -- ----------------------    it "adds parameters to a complex rhs of a declaration" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn7.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (10, 17) renamed-      let-        comp = do-         parsed <- getRefactParsed-         declsp <- liftT $ hsDecls parsed-         let decl = head declsp--         let newName1 = mkRdrName "x1"-         let newName2 = mkRdrName "y1"-         let newName3 = mkRdrName "z1"-         newBinding <- addActualParamsToRhs n [newName1,newName2,newName3] decl--         return (newBinding,decl)-      ((nb,decl'),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual decl') `shouldBe` "fun x y z\n  = inc addthree\n  where\n      inc a = a + 1\n      addthree = x + y + z"-      (showGhcQual n) `shouldBe` "addthree"-      (showGhcQual nb) `shouldBe` "fun x y z\n  = inc (addthree x1 y1 z1)\n  where\n      inc a = a + 1\n      addthree = x + y + z"-      (exactPrintFromState s nb) `shouldBe` "\n\n--A definition can be lifted from a where or let to the top level binding group.\n--Lifting a definition widens the scope of the definition.\n\n--In this example, lift 'addthree' defined in 'fun'.\n--This example aims to test adding parenthese.\n\n\nfun x y z =inc (addthree x1 y1 z1)\n       where inc a =a +1\n             addthree=x+y+z"---  -- -----------------------------------------------  describe "rmDecl" $ do-    it "removes a top level declaration, leaving type signature 1" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1a.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (6, 1) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns--         return parsed'-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1a.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1a where\n\ndata D = A | B String | C\n\nff :: Int -> Int\n\nl = 1\n\n"--    -- -----------------------------------    it "removes a top level declaration, leaving type signature 2b" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1b.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (6, 1) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns-         return parsed'-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1b.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1b where\n\ndata D = A | C\n\nff :: Int -> Int\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\n"--    -- -----------------------------------    it "removes a top level declaration, leaving type signature 2" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (22, 1) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns-         logDataWithAnns "parsed'" parsed'-         return parsed'-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"--    -- -----------------------------------    it "removes a top level declaration, and type signature" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (22, 1) renamed-      let-        comp = do-         (newDecls,_removedDecl,_removedSig) <- rmDecl n True parsed-         putRefactParsed newDecls emptyAnns-         return newDecls-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"--    -- -------------------------------------    it "removes the last local decl in a let/in clause" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/LetIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _ n) = locToName (11, 22) renamed-      let-        comp = do-         parsed <- getRefactParsed-         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed--         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "sq"-      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""-      (sourceFromState s) `shouldBe` "module LiftToToplevel.LetIn1 where\n\n--A definition can be lifted from a where or let to the top level binding group.\n--Lifting a definition widens the scope of the definition.\n\n--In this example, lift 'sq' in 'sumSquares'\n--This example aims to test lifting a definition from a let clause to top level,\n--and the elimination of the keywords 'let' and 'in'\n\nsumSquares x y = sq x + sq y\n                       where pow=2\n\nanotherFun 0 y = sq y\n     where sq x = x^2\n"--    -- -------------------------------------    it "removes the last local decl in a where clause" $ do-      t <- ct $ parsedFileGhc "./RmDecl3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (6, 5) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed--         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "zz"-      (sourceFromState s) `shouldBe` "module RmDecl3 where\n\n-- Remove last declaration from a where clause, where should disappear too\nff y = y + zz\n\n-- EOF\n"--    -- -------------------------------------    it "removes the first local decl in a where clause" $ do-      t <- ct $ parsedFileGhc "./RmDecl4.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let Just (GHC.L _ n) = locToName (7, 5) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed--         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "zz"-      (sourceFromState s) `shouldBe` "{-# LANGUAGE FlexibleContexts #-}\nmodule RmDecl4 where\n\n-- Remove first declaration from a where clause, rest should still be indented\nff y = y + zz ++ xx\n  where\n    xx = 2\n\n-- EOF\n"--    -- -------------------------------------    it "removes the non last local decl in a let/in clause 1" $ do-      t <- ct $ parsedFileGhc "./Demote/LetIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""--      let Just (GHC.L _ n) = locToName (12, 22) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "pow"-      (sourceFromState s) `shouldBe` "module Demote.LetIn1 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the local  'pow' to 'sq'\n--This example also aims to test the demoting a local declaration in 'let'.\n\nsumSquares x y = let sq 0=0\n                     sq z=z^pow\n                 in sq x + sq y\n\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n  "--    -- -------------------------------------    it "removes the non last local decl in a let/in clause 2" $ do-      t <- ct $ parsedFileGhc "./Demote/LetIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (10, 22) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "sq"-      (sourceFromState s) `shouldBe` "module Demote.LetIn2 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the local  'pow' will fail.\n\nsumSquares x y = let pow=2\n                 in sq x + sq y +pow\n\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n  "--    -- -------------------------------------------------------------------    it "removes a decl with a trailing comment" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (14, 1) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig1) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "Demote.WhereIn3.sq"-      (sourceFromState s) `shouldBe` "module Demote.WhereIn3 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where p=2  {-There is a comment-}\n\nsq :: Int -> Int -> Int\n\n{- foo bar -}\nanotherFun 0 y = sq y\n     where  sq x = x^2\n"---    -- -------------------------------------------------------------------    it "removes a sub decl liftOneLevel D1" $ do-      t <- ct $ parsedFileGhc "./LiftOneLevel/D1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (8, 6) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig1) <- rmDecl n False parsed-         putRefactParsed parsed' emptyAnns--         return parsed'-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "sq"-      (sourceFromState s) `shouldBe` "module LiftOneLevel.D1 where\n\n{-lift 'sq' to top level. This refactoring\naffects module 'D1' and 'C1' -}\n\nsumSquares (x:xs) = sq x + sumSquares xs\n  where\n     pow =2\n\nsumSquares [] = 0\n\nmain = sumSquares [1..4]\n"---  -- -----------------------------------------------  describe "rmTypeSig" $ do-    it "removes a type signature from the top level 1" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (22, 1) renamed-      let-        comp = do-         (renamed',sigRemoved) <- rmTypeSig n parsed-         putRefactParsed renamed' emptyAnns-         return (renamed',sigRemoved)-      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (showGhcQual os) `shouldBe` "Just ff :: Int -> Int"--    -- -------------------------------------------------------------------    it "removes a type signature from the top level, after decl removed" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (14, 1) renamed-      let-        comp = do-         (parsed',_removedDecl,_removedSig1) <- rmDecl    n False parsed-         (parsed2,_removedSig2)              <- rmTypeSig n parsed'-         putRefactParsed parsed2 emptyAnns--         return parsed2-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "Demote.WhereIn3.sq"-      (sourceFromState s) `shouldBe` "module Demote.WhereIn3 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where p=2  {-There is a comment-}\n\n{- foo bar -}\nanotherFun 0 y = sq y\n     where  sq x = x^2\n"---    -- -------------------------------------------------------------------    it "removes a type signature from non-top level" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (16, 5) renamed-      let-        comp = do-         (renamed',_removedSig) <- rmTypeSig n parsed-         putRefactParsed renamed' emptyAnns-         return renamed'-      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "ff"-      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"--    -- -------------------------------------------------------------------    it "removes a type signature within multi signatures 1" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TypeSigs.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ b) = locToName (12, 1) renamed-      let-        comp = do-         (renamed',removedSig) <- rmTypeSig b parsed-         putRefactParsed renamed' emptyAnns-         return (renamed',removedSig)-      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nb::Int->Integer->Char"-      (showGhcQual b) `shouldBe` "TypeSigs.b"-      (sourceFromState s) `shouldBe` "module TypeSigs where\n\nsq,anotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^2\n\nanotherFun x = x^2\n\na,c::Int->Integer->Char\n\na x y = undefined\nb x y = undefined\nc x y = undefined\n\n"--    -- -------------------------------------------------------------------    it "removes a type signature within multi signatures 2" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/TypeSigs.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (4, 1) renamed-      let-        comp = do-         (renamed',removedSig) <- rmTypeSig n parsed-         putRefactParsed renamed' emptyAnns-         return (renamed',removedSig)-      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- putStrLn $ "anntree\n" ++ showAnnDataFromState s-      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nsq :: Int -> Int"-      (showGhcQual n) `shouldBe` "TypeSigs.sq"-      (sourceFromState s) `shouldBe` "module TypeSigs where\n\nanotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^2\n\nanotherFun x = x^2\n\na,b,c::Int->Integer->Char\n\na x y = undefined\nb x y = undefined\nc x y = undefined\n\n"-      (showGhcQual os) `shouldBe` "Just sq :: Int -> Int"--    -- -------------------------------------------------------------------    it "removes a type signature within multi signatures 3" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn7.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let Just (GHC.L _ n) = locToName (12, 1) renamed-      let-        comp = do-         (parsed',removedSig) <- rmTypeSig n parsed-         putRefactParsed parsed' emptyAnns-         return (parsed',removedSig)-      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "WhereIn7.sq"-      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nsq :: Int -> Int"-      (sourceFromState s) `shouldBe` "module WhereIn7 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--This example also aims to test the split of type signature.\n\nsumSquares x y = sq x + sq y\n\nanotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^pow\n   where  pow=2\n\nanotherFun x = x^2\n "-      (showGhcQual os) `shouldBe` "Just sq :: Int -> Int"--    -- ------------------------------------------------------------------{--    it "removes a type signature for a pattern in a bind" $ do-      t <- ct $ parsedFileGhc "./LiftToToplevel/PatBindIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n) = locToName (GHC.mkFastString "./test/testdata/LiftToToplevel/PatBindIn1.hs") (18, 7) renamed-      let-        comp = do-         (renamed',removedSig) <- rmTypeSig n renamed-         let (Just (GHC.L ss _)) = removedSig-         oldSigToks <- getToksForSpan ss-         return (renamed',removedSig,oldSigToks)-      -- ((nb,os,ot),s) <- runRefactGhc comp $ initialState { rsModule = initRefactModule [] t }-      ((nb,os,ot),s) <- runRefactGhc comp $ initialLogOnState { rsModule = initRefactModule [] t }-      (showGhcQual n) `shouldBe` "tup"-      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""-      (sourceFromState s) `shouldBe` "module LiftToToplevel.PatBindIn1 where\n\n --A definition can be lifted from a where or let into the surrounding binding group.\n --Lifting a definition widens the scope of the definition.\n\n --In this example, lift 'tup' defined in 'foo'\n --This example aims to test renaming and the lifting of type signatures.\n\n main :: Int\n main = foo 3\n\n foo :: Int -> Int\n foo x = h + t + (snd tup)\n       where\n       \n       \n\n       tup@(h,t) = head $ zip [1..10] [3..15]\n "-      (showGhcQual nb) `shouldBe` ""-      (showGhcQual os) `shouldBe` ""-      (GHC.showRichTokenStream ot) `shouldBe` ""--}-  -- -----------------------------------------------  describe "addDecl" $ do-    it "adds a top level declaration without a type signature, in default pos" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let-        comp = do-         parsed <- getRefactParsed-         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "a" "nn = n2")-         -- let declAnns' = setPrecedingLines declAnns newDecl 2-         parsed' <- addDecl parsed Nothing ([decl],Just declAnns)-         putRefactParsed parsed' emptyAnns-         return parsed'-      (nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\nnn = n2\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\nnn = n2\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"--    -- ---------------------------------------------    it "adds a top level declaration with a type signature 1" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let-        comp = do-         parsed <- getRefactParsed-         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = 2")-         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")-         parsed' <- addDecl parsed Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)-         putRefactParsed parsed' emptyAnns-         return (sig,parsed')-      ((_hs,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\nnn :: Int\nnn = 2\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\nnn :: Int\nnn = 2\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"--    -- ---------------------------------------------    it "adds a top level declaration after a specified one" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let-        comp = do-         parsed <- getRefactParsed-         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "a" "nn = nn2")-         renamed <- getRefactRenamed-         let Just (GHC.L _l n) = locToName (21, 1) renamed-         parsed' <- addDecl parsed (Just n) ([decl],Just declAnns)-         putRefactParsed parsed' emptyAnns-         return (n,parsed')-      ((n,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((n,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"-      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nnn = nn2\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nnn = nn2\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"---    -- ---------------------------------------------    it "adds a top level declaration with a type signature after a specified one" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let-        comp = do-         renamed <- getRefactRenamed-         let Just (GHC.L _l n) = locToName (21, 1) renamed-         parsed <- getRefactParsed-         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")-         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")-         parsed' <- addDecl parsed (Just n) ([sig,decl],Just $ mergeAnns sigAnns declAnns)-         putRefactParsed parsed' emptyAnns-         return (n,parsed')-      ((nn,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual nn) `shouldBe` "MoveDef.Md1.ff"-      (sourceFromState s) `shouldBe`"module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nnn :: Int\nnn = nn2\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"-      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nnn :: Int\nnn = nn2\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"---    -- ---------------------------------------------    it "adds a local declaration without a type signature 1" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"--      let-        comp = do-         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (4, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")--         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)--         logm $ "test:addDecl done"--         return (tlDecl,newDecl)-      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "toplevel x = c * x"-      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn = nn2"-      (showGhcQual nb)           `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2"--    -- ---------------------------------------------    it "adds a local declaration with a type signature 1" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"-      let-        comp = do-         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (4, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")-         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")--         newDecl <- addDecl tlDecl Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)--         return (tlDecl,newDecl)-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "toplevel x = c * x"-      -- putStrLn (showAnnDataItemFromState s nb)-      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn :: Int\n    nn = nn2"-      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2\n      nn :: Int"-    -- ---------------------------------------------    it "adds a local declaration with a where clause" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Demote.hs"-      let-        comp = do--         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (4, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")--         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)--         return (tlDecl,newDecl)-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "toplevel x = c * x"-      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn = nn2"-      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2"--    -- ---------------------------------------------    it "adds a local declaration to an existing one" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md2.hs"-      let-        comp = do--         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (4, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")--         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)--         return (tlDecl,newDecl)-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3"-      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x * b\n  where\n    nn = nn2\n\n    b = 3"-      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3\n      nn = nn2"--    -- ---------------------------------------------    it "adds a local declaration with a type signature to an existing one" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Md2.hs"-      let-        comp = do--         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (4, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")-         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")--         newDecl <- addDecl tlDecl Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)--         return (tlDecl,newDecl)-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3"-      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x * b\n  where\n    nn :: Int\n    nn = nn2\n\n    b = 3"-      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3\n      nn = nn2\n      nn :: Int"--    -- ---------------------------------------------    it "adds a local decl with type signature to an existing one, with a comment" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"-      let-        comp = do-         parsed  <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (10, 1) renamed-         decls <- liftT (hsDecls parsed)-         let [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         let Just (GHC.L _ sq) = locToName (14, 1) renamed-         let Just (GHC.L _ af) = locToName (18, 1) renamed--         let [sqSig]  = definingSigsRdrNames  nameMap [sq] parsed-             [sqDecl] = definingDeclsRdrNames nameMap [sq] decls False False-             [afDecl] = definingDeclsRdrNames nameMap [af] decls False False--         let  sqSigDecl = wrapSig sqSig-         liftT (balanceComments tlDecl sqSigDecl)-         liftT (balanceComments sqDecl afDecl)--         newDecl <- addDecl tlDecl Nothing ([sqSigDecl,sqDecl],Nothing)--         return (sqSig,sqDecl,tlDecl,afDecl,newDecl)-      -- ((sigs,_sd,tl,aa,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      ((sigs,_sd,tl,aa,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual sigs) `shouldBe` "sq :: Int -> Int -> Int"-      (showGhcQual tl) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"-      (showGhcQual aa) `shouldBe` "anotherFun 0 y\n  = sq y\n  where\n      sq x = x ^ 2"-      (exactPrintFromState s nb) `shouldBe` "\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where sq :: Int -> Int -> Int\n               sq pow 0 = 0\n               sq pow z = z^pow  --there is a comment\n\n               p=2  {-There is a comment-}"-      (showGhcQual nb) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2\n      sq :: Int -> Int -> Int\n      sq pow 0 = 0\n      sq pow z = z ^ pow"--    -- ---------------------------------------------    it "does not add a local decl to a FunBind with multiple matches" $ do-      t <- ct $ parsedFileGhc "./MoveDef/MultiFunBind1.hs"-      let-        comp = do-         parsed  <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (3, 1) renamed-         decls <- liftT (hsDecls parsed)-         let -- decls = hsBinds parsed-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         let Just (GHC.L _ y) = locToName (6, 1) renamed--         let [yDecl] = definingDeclsRdrNames nameMap [y] decls False False--         newDecl <- addDecl tlDecl Nothing ([yDecl],Nothing)--         return (yDecl,tlDecl,newDecl)-      r <- catchException $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      r `shouldBe` Just  "addDecl:Cannot add a local decl to a FunBind with multiple matches"--    -- ---------------------------------------------    it "adds a local declaration to a PatBind" $ do-      t <- ct $ parsedFileGhc "./MoveDef/PatBind1.hs"-      let-        comp = do--         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         nameMap <- getRefactNameMap--         let Just (GHC.L _ tl) = locToName (3, 1) renamed-         decls <- liftT (hsDecls parsed)-         let-             [tlDecl] = definingDeclsRdrNames nameMap [tl] decls True False--         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")--         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)--         return (tlDecl,newDecl)-      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual tl) `shouldBe` "tup@(h, t) = (x, 1)"-      (exactPrintFromState s nb) `shouldBe` "\n\ntup@(h,t) = (x,1)\n  where\n    nn = nn2"-      (showGhcQual nb) `shouldBe` "tup@(h, t)\n  = (x, 1)\n  where\n      nn = nn2"--  -- -----------------------------------------------  describe "renamePN" $ do-    it "replaces a Name with another, updating tokens 1" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         parsed <- getRefactParsed-         renamed <- getRefactRenamed-         let Just (GHC.L _l n') = locToName (3, 1) renamed-         newName <- mkNewGhcName Nothing "bar2"-         new <- renamePN n' newName False parsed-         putRefactParsed new emptyAnns-         return (new,newName,n')-      let--      ((nb,nn,n),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual (n,nn)) `shouldBe` "(DupDef.Dd1.toplevel, bar2)"-      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\nbar2 :: Integer -> Integer\nbar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"-      (showGhcQual nb) `shouldBe` "module DupDef.Dd1 where\nbar2 :: Integer -> Integer\nbar2 x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n  = head $ zip [1 .. 10] [3 .. ff]\n  where\n      ff :: Int\n      ff = 15\ndata D = A | B String | C\nff y\n  = y + zz\n  where\n      zz = 1\nl z = let ll = 34 in ll + z\ndd q\n  = do { let ss = 5;\n         return (ss + q) }"--    -- -------------------------------------------------------------------    it "replaces a Name with another, updating tokens 2" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn4.hs"--      let-        comp = do-         renamed <- getRefactRenamed-         parsed <- getRefactParsed-         declsr <- liftT $ hsDecls parsed-         let decl = head $ drop 0 declsr-         let Just (GHC.L _l n') = locToName (11, 21) renamed-         newName <- mkNewGhcName Nothing "p_1"-         new <- renamePN n' newName False decl-         parsed' <- liftT $ replaceDecls parsed (new:tail declsr)-         putRefactParsed parsed' emptyAnns-         return (new,newName,decl,n')-      let-      ((nb,nn,d,n),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual d) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"-      (showGhcQual (n,nn)) `shouldBe` "(p, p_1)"-      (sourceFromState s) `shouldBe` "module Demote.WhereIn4 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there is single matches), if possible,\n--the parameters will be folded after demoting and type sigature will be removed.\n\nsumSquares x y = sq p_1 x + sq p_1 y\n         where p_1=2  {-There is a comment-}\n\nsq::Int->Int->Int\nsq pow z = z^pow  --there is a comment\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n"-      (showGhcQual nb) `shouldBe` "sumSquares x y\n  = sq p_1 x + sq p_1 y\n  where\n      p_1 = 2"---    -- -----------------------------------    it "replaces a Name with another in limited scope, updating tokens 1" $ do-      t <- ct $ parsedFileGhc "./TokenTest.hs"--      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n) = locToName (19, 1) renamed-      (showGhcQual n) `shouldBe` "TokenTest.foo"--      let-        comp = do-         parsed <- getRefactParsed-         decls <- liftT $ hsDecls parsed-         newName <- mkNewGhcName Nothing "bar2"-         new <- renamePN n newName False (head $ drop 3 decls)-         parsed' <- liftT $ replaceDecls parsed (take 3 decls ++ [new] ++ drop 4 decls)-         putRefactParsed parsed' emptyAnns-         return (new,newName)-      let--      ((nb,nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual (n,nn)) `shouldBe` "(TokenTest.foo, bar2)"-      (sourceFromState s) `shouldBe` "module TokenTest where\n\n-- Test new style token manager\n\nbob a b = x\n  where x = 3\n\nbib a b = x\n  where\n    x = 3\n\n\nbab a b =\n  let bar = 3\n  in     b + bar -- ^trailing comment\n\n\n-- leading comment\nbar2 x y =\n  do c <- getChar\n     return c\n\n\n\n\n"-      (showGhcQual nb) `shouldBe` "bar2 x y\n  = do { c <- getChar;\n         return c }"-      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""--    -- -----------------------------------    it "replace a Name with another in limited scope, updating tokens 2" $ do-      t <- ct $ parsedFileGhc "./TokenTest.hs"--      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n) = locToName (19, 1) renamed-      (showGhcQual n) `shouldBe` "TokenTest.foo"--      let-        comp = do-         parsed <- getRefactParsed-         decls <- liftT $ hsDecls parsed-         let decl = head $ drop 3 decls-         newName <- mkNewGhcName Nothing "bar2"-         new <- renamePN n newName False decl--         parsed' <- liftT $ replaceDecls parsed (take 3 decls ++ [new] ++ drop 4 decls)-         putRefactParsed parsed' emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "TokenTest.foo"-      (sourceFromState s) `shouldBe` "module TokenTest where\n\n-- Test new style token manager\n\nbob a b = x\n  where x = 3\n\nbib a b = x\n  where\n    x = 3\n\n\nbab a b =\n  let bar = 3\n  in     b + bar -- ^trailing comment\n\n\n-- leading comment\nbar2 x y =\n  do c <- getChar\n     return c\n\n\n\n\n"-      (showGhcQual nb) `shouldBe` "bar2 x y\n  = do { c <- getChar;\n         return c }"-      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""--    --------------------------------------    it "replaces a name in a data declaration too" $ do-      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (5, 19) renamed-      let-        comp = do-         newName <- mkNewGhcName Nothing "pointx1"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)-      let--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "Field1.pointx"-      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata Point = Pt {pointx1, pointy :: Float}\n\nabsPoint :: Point -> Float\nabsPoint p = sqrt (pointx1 p * pointx1 p +\n                  pointy p * pointy p)\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module Field1 where\ndata Point = Pt {pointx1, pointy :: Float}\nabsPoint :: Point -> Float\nabsPoint p = sqrt (pointx1 p * pointx1 p + pointy p * pointy p)"---    --------------------------------------    it "replaces a name in a type signature too" $ do-      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (5, 6) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)-         newName <- mkNewGhcName Nothing "NewPoint"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)-      let--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "Field1.Point"-      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata NewPoint = Pt {pointx, pointy :: Float}\n\nabsPoint :: NewPoint -> Float\nabsPoint p = sqrt (pointx p * pointx p +\n                  pointy p * pointy p)\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module Field1 where\ndata NewPoint = Pt {pointx, pointy :: Float}\nabsPoint :: NewPoint -> Float\nabsPoint p = sqrt (pointx p * pointx p + pointy p * pointy p)"--    --------------------------------------    it "replace a name in a FunBind with multiple patterns" $ do-      t <- ct $ parsedFileGhc "./LocToName.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (20, 1) renamed-      let-        comp = do-         newName <- mkNewGhcName Nothing "newPoint"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)-      let--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "LocToName.sumSquares"-      (sourceFromState s) `shouldBe` "module LocToName where\n\n{-\n\n\n\n\n\n\n\n\n-}\n\n\n\n\n\n\n\nnewPoint (x:xs) = x ^2 + newPoint xs\n    -- where sq x = x ^pow \n    --       pow = 2\n\nnewPoint [] = 0\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LocToName where\nnewPoint (x : xs) = x ^ 2 + newPoint xs\nnewPoint [] = 0"--    --------------------------------------    it "replaces a qualified name in a FunBind with multiple patterns" $ do-      t <- ct $ parsedFileGhc "./LocToName.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")--      let Just (GHC.L _l n) = locToName (20, 1) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)-         newName <- mkNewGhcName (Just modu) "newPoint"-         new <- renamePN n newName True parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n) `shouldBe` "LocToName.sumSquares"-      (unspace $ showGhcQual nb) `shouldBe` "module LocToName where\nLocToName.newPoint (x : xs) = x ^ 2 + LocToName.newPoint xs\nLocToName.newPoint [] = 0"-      (sourceFromState s) `shouldBe` "module LocToName where\n\n{-\n\n\n\n\n\n\n\n\n-}\n\n\n\n\n\n\n\nnewPoint (x:xs) = x ^2 + LocToName.newPoint xs\n    -- where sq x = x ^pow \n    --       pow = 2\n\nnewPoint [] = 0\n"---    --------------------------------------    it "replaces a parameter name in a FunBind" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _ n) = locToName (8, 7) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "ls"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- (showGhcQual $ sourceTreeFromState s) `shouldBe` ""-      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly ls = case ls of  (1:xs) -> 1\n--There is a comment\n                       (2:xs)\n                         | x < 10    -> 4  where  x = last xs\n                       otherwise -> 12\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly ls\n = case ls of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"---    --------------------------------------    it "does not qualify a name in an import hiding clause" $ do-      t <- ct $ parsedFileGhc "./ScopeAndQual.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")--      let Just (GHC.L _l n) = locToName (4, 24) renamed-      let-        comp = do-         newName <- mkNewGhcName (Just modu) "mySum"-         new <- renamePN n newName True parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "Data.Foldable.sum"-      (sourceFromState s) `shouldBe` "module ScopeAndQual where\n\nimport qualified Data.List as L\nimport Prelude hiding (mySum)\n\nmain :: IO ()\nmain = putStrLn (show $ L.mySum [1,2,3])\n\nsum a b = a + b\n\nsumSquares xs = L.mySum $ map (\\x -> x*x) xs\n\nmySumSq = sumSquares\n"-      (unspace $ showGhcQual nb) `shouldBe` "module ScopeAndQual where\nimport qualified Data.List as L\nimport Prelude hiding ( mySum )\nmain :: IO ()\nmain = putStrLn (show $ L.mySum [1, 2, 3])\nsum a b = a + b\nsumSquares xs = L.mySum $ map (\\ x -> x * x) xs\nmySumSq = sumSquares"---    --------------------------------------    it "does not qualify the subject of a type signature" $ do-      t <- ct $ parsedFileGhc "./Renaming/C7.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")--      let Just (GHC.L _l n) = locToName (5, 1) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)-         newName <- mkNewGhcName (Just modu) "myNewFringe"--         new <- renamePN n newName True parsed-         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,_nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "Renaming.C7.myFringe"-      (sourceFromState s) `shouldBe` "module Renaming.C7(LocToName.myNewFringe)  where\n\nimport Renaming.D7\n\nmyNewFringe:: Tree a -> [a]\nmyNewFringe (Leaf x ) = [x]\nmyNewFringe (Branch left right) = LocToName.myNewFringe left ++ fringe right\n\n\n\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module Renaming.C7 (\n LocToName.myNewFringe\n ) where\nimport Renaming.D7\nmyNewFringe :: Tree a -> [a]\nLocToName.myNewFringe (Leaf x) = [x]\nLocToName.myNewFringe (Branch left right)\n = LocToName.myNewFringe left ++ fringe right"--    --------------------------------------    it "realigns toks in a case for a shorter name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (8, 7) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "ls"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "list"-      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly ls = case ls of  (1:xs) -> 1\n--There is a comment\n                       (2:xs)\n                         | x < 10    -> 4  where  x = last xs\n                       otherwise -> 12\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly ls\n = case ls of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"----    --------------------------------------    it "realigns toks in a case for a longer name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (8, 7) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "listlonger"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "list"-      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly listlonger = case listlonger of  (1:xs) -> 1\n            --There is a comment\n                                       (2:xs)\n                                         | x < 10    -> 4  where  x = last xs\n                                       otherwise -> 12\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly listlonger\n = case listlonger of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"---    --------------------------------------    it "realigns toks in a do for a shorter name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn4.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (7, 8) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "io"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "ioFun"-      (sourceFromState s) `shouldBe` "module LayoutIn4 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'ioFun' to  'io'\n\nmain = io \"hello\" where io s= do  let  k = reverse s\n--There is a comment\n                                  s <- getLine\n                                  let  q = (k ++ s)\n                                  putStr q\n                                  putStr \"foo\"\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn4 where\nmain\n = io \"hello\"\n where\n io s\n = do { let k = reverse s;\n s <- getLine;\n let q = (k ++ s);\n putStr q;\n putStr \"foo\" }"---    --------------------------------------    it "realigns toks in a do for a longer name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn4.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (7, 8) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "ioFunLong"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "ioFun"-      (sourceFromState s) `shouldBe` "module LayoutIn4 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'ioFun' to  'io'\n\nmain = ioFunLong \"hello\" where ioFunLong s= do  let  k = reverse s\n         --There is a comment\n                                                s <- getLine\n                                                let  q = (k ++ s)\n                                                putStr q\n                                                putStr \"foo\"\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn4 where\nmain\n = ioFunLong \"hello\"\n where\n ioFunLong s\n = do { let k = reverse s;\n s <- getLine;\n let q = (k ++ s);\n putStr q;\n putStr \"foo\" }"--    --------------------------------------    it "realigns toks in a where for a shorter name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (7, 17) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "q"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "sq"-      (sourceFromState s) `shouldBe` "module LayoutIn1 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'sq' to 'square'.\n\nsumSquares x y= q x + q y where q x= x^pow\n--There is a comment.\n                                pow=2\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn1 where\nsumSquares x y\n = q x + q y\n where\n q x = x ^ pow\n pow = 2"---    --------------------------------------    it "realigns toks in a where for a longer name" $ do-      t <- ct $ parsedFileGhc "./Renaming/LayoutIn1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (7, 17) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "square"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "sq"-      (sourceFromState s) `shouldBe` "module LayoutIn1 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'sq' to 'square'.\n\nsumSquares x y= square x + square y where square x= x^pow\n          --There is a comment.\n                                          pow=2\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn1 where\nsumSquares x y\n = square x + square y\n where\n square x = x ^ pow\n pow = 2"--    --------------------------------------    it "realigns toks in a let/in for a shorter name" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (6, 6) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "x"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "xxx"-      (sourceFromState s) `shouldBe` "module LayoutLet1 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n\nfoo x = let a = 1\n            b = 2\n        in x + a + b\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet1 where\nfoo x\n = let\n a = 1\n b = 2\n in x + a + b"--    --------------------------------------    it "realigns toks in a let/in for a longer name 1" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (6, 6) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "xxxlong"-         -- new <- renamePN n newName False renamed-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "xxx"-      (sourceFromState s) `shouldBe` "module LayoutLet1 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n\nfoo xxxlong = let a = 1\n                  b = 2\n              in xxxlong + a + b\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet1 where\nfoo xxxlong\n = let\n a = 1\n b = 2\n in xxxlong + a + b"---    --------------------------------------    it "realigns toks in a let/in for a longer name 2" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (7, 6) renamed-      let-        comp = do-         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)--         newName <- mkNewGhcName Nothing "xxxlong"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns--         return (new,newName)--      ((nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual (n,nn)) `shouldBe` "(xxx, xxxlong)"-      (sourceFromState s) `shouldBe` "module LayoutLet2 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n-- In this case the tokens for xxx + a + b should also shift out\n\nfoo xxxlong = let a = 1\n                  b = 2 in xxxlong + a + b\n\n"-      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet2 where\nfoo xxxlong\n = let\n a = 1\n b = 2\n in xxxlong + a + b"---    --------------------------------------    it "renames an exported data type" $ do-      t <- ct $ parsedFileGhc "./Renaming/RenameInExportedType2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let Just (GHC.L _l n) = locToName (6, 24) renamed-      let-        comp = do-         logm $ "parsed:" ++ (SYB.showData SYB.Parser 0 parsed)--         newName <- mkNewGhcName Nothing "NewType"-         new <- renamePN n newName False parsed--         putRefactParsed new emptyAnns-         logm $ "parsed:after" ++ (SYB.showData SYB.Parser 0 new)--         return (new,newName)--      ((_nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((_nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual (n,nn)) `shouldBe` "(Renaming.RenameInExportedType.NT, NewType)"-      (sourceFromState s) `shouldBe` "module Renaming.RenameInExportedType\n  (\n  MyType (NewType)\n  ) where\n\ndata MyType = MT Int | NewType\n\n\n"---  -- -----------------------------------------------  describe "qualifyToplevelName" $ do-    it "qualifies a name at the top level" $ do-      t <- ct $ parsedFileGhc "./Renaming/C7.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t--      let Just (GHC.L _l n) = locToName (7, 1) renamed-      let-        comp = do-         qualifyToplevelName n--         return ()-      let--      (_,s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual n) `shouldBe` "Renaming.C7.myFringe"-      (sourceFromState s) `shouldBe` "module Renaming.C7(Renaming.C7.myFringe)  where\n\nimport Renaming.D7\n\nmyFringe:: Tree a -> [a]\nmyFringe (Leaf x ) = [x]\nmyFringe (Branch left right) = Renaming.C7.myFringe left ++ fringe right\n\n\n\n\n"----  -- -----------------------------------------------  describe "findEntity" $ do-    it "returns true if a (Located) Name is part of a HsBind 1" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         parentr <- getRefactRenamed--         let mn = locToName (4,1) parentr-         let (Just (ln@(GHC.L _ n))) = mn--         let declsr = hsBinds parentr-             duplicatedDecls = definingDeclsNames [n] declsr True False--             res  = findEntity ln duplicatedDecls-             res2 = findEntity n duplicatedDecls-             -- res = findEntity' ln duplicatedDecls--         return (res,res2,duplicatedDecls,ln)-      ((r,r2,d,_l),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual d) `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"-      (showGhcQual _l) `shouldBe` "DupDef.Dd1.toplevel"-      ("1" ++ show r) `shouldBe` "1True"-      ("2" ++ show r2) `shouldBe` "2True"--    -- -----------------------------------    it "returns true if a (Located) Name is part of a HsBind 2" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         parentr <- getRefactRenamed--         let mn = locToName (31,7) parentr-         let (Just (ln@(GHC.L _ n))) = mn--         let mnd = locToName (30,1) parentr-         let (Just ((GHC.L _ nd))) = mnd--         let declsr = hsBinds parentr-             duplicatedDecls = definingDeclsNames [nd] declsr True False--             res = findEntity ln duplicatedDecls-             res2 = findEntity  n duplicatedDecls--         return (res,res2,duplicatedDecls,ln)-      ((r,r2,d,_l),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual d) `shouldBe` "[DupDef.Dd1.dd q\n   = do { let ss = 5;\n"++-                             "          GHC.Base.return (ss GHC.Num.+ q) }]"-      (showGhcQual _l) `shouldBe` "ss"-      ("1" ++ show r) `shouldBe` "1True"-      ("2" ++ show r2) `shouldBe` "2True"---    -- -------------------------------------------------------------------    it "returns false if a syntax phrase is not part of another" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         parentr <- getRefactRenamed--         let mn = locToName (4,1) parentr-         let (Just (ln@(GHC.L _ n))) = mn--         let mltup = locToName (11,1) parentr-         let (Just ((GHC.L _ tup))) = mltup--         let declsr = hsBinds parentr-             duplicatedDecls = definingDeclsNames [n] declsr True False--             res = findEntity tup duplicatedDecls-             -- res = findEntity' ln duplicatedDecls--         return (res,duplicatedDecls,ln)-      ((r,d,_l),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual d) `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"-      ("1" ++ show r) `shouldBe` "1False"--    -- -------------------------------------------------------------------    it "Finds an entity in [HsBind Name]" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (MatchGroup matches _)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (HsLet decls _)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (HsLet _ e1)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (HsLet decls _)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (PatBind pat rhs _ _ _)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (Match _ _ rhs)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (LetStmt binds)" $ do-      pending -- "write this test"--    -- -------------------------------------------------------------------    it "Finds an entity in (BindStmt _ rhs _ _)" $ do-      pending -- "write this test"---  -- -----------------------------------------------  describe "modIsExported" $ do-    it "Returns True if the module is explicitly exported" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let renamed = fromJust $ GHC.tm_renamed_source t-      let (Just (modName,_)) = getModuleName parsed--      (modIsExported modName renamed) `shouldBe` True--    it "Returns True if the module is exported by default" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let renamed = fromJust $ GHC.tm_renamed_source t-      let (Just (modName,_)) = getModuleName parsed--      (modIsExported modName renamed) `shouldBe` True--    it "Returns False if the module is explicitly not exported" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare2.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t-      let renamed = fromJust $ GHC.tm_renamed_source t-      let (Just (modName,_)) = getModuleName parsed--      (modIsExported modName renamed) `shouldBe` False--  -- -----------------------------------------------  describe "isExported" $ do-    it "returns True if a GHC.Name is exported" $ do-      t <- ct $ parsedFileGhc "./Renaming/B1.hs"--      let-        comp = do-         renamed <- getRefactRenamed--         let mn1 = locToName (11,1) renamed-         let (Just (GHC.L _ myFringe)) = mn1--         let mn2 = locToName (15,1) renamed-         let (Just (GHC.L _ sumSquares)) = mn2--         exMyFring <- isExported myFringe-         exSumSquares <- isExported sumSquares--         return (myFringe,exMyFring,sumSquares,exSumSquares)-      ((mf,emf,ss,ess),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t}) testOptions--      (showGhcQual mf) `shouldBe` "Renaming.B1.myFringe"-      emf `shouldBe` True-      (showGhcQual ss) `shouldBe` "Renaming.B1.sumSquares"-      ess `shouldBe` False--  -- -----------------------------------------------  describe "addHiding" $ do-    it "add a hiding entry to the imports with no existing hiding" $ do-      t1 <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         clearParsedModule-         t2 <- parseSourceFileTest "./DupDef/Dd2.hs"-         let renamed1 = fromJust $ GHC.tm_renamed_source t1-         let renamed2 = fromJust $ GHC.tm_renamed_source t2--         let parsed1 = GHC.pm_parsed_source $ GHC.tm_parsed_module t1-         let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2--         let mn = locToName (4,1) renamed1-         let (Just (GHC.L _ _n)) = mn--         let Just (modName,_) = getModuleName parsed1-         let-           n1 = mkRdrName "n1"-           n2 = mkRdrName "n2"-         res  <- addHiding modName parsed2 [n1,n2]-         putRefactParsed res emptyAnns--         return (res,renamed2)-      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t1}) testOptions-      -- ((_r,_r2),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t1}) testOptions--      (sourceFromState s) `shouldBe` "module DupDef.Dd2 where\n\nimport DupDef.Dd1 hiding (n1,n2)\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"--    --------------------------------------    it "adds a hiding entry to the imports with an existing hiding" $ do-      t1 <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do--         clearParsedModule-         t2 <- parseSourceFileTest "./DupDef/Dd3.hs"-         let renamed1 = fromJust $ GHC.tm_renamed_source t1-         let renamed2 = fromJust $ GHC.tm_renamed_source t2--         let parsed1 = GHC.pm_parsed_source $ GHC.tm_parsed_module t1-         let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2--         let mn = locToName (4,1) renamed1-         let (Just (GHC.L _ _n)) = mn--         let Just (modName,_) = getModuleName parsed1-         let-           n1 = mkRdrName "n1"-           n2 = mkRdrName "n2"-         res  <- addHiding modName parsed2 [n1,n2]--         return (res,renamed2)-      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t1}) testOptions-      (sourceFromState s) `shouldBe` "module DupDef.Dd3 where\n\nimport DupDef.Dd1 hiding (dd,n1,n2)\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"--  -- -----------------------------------------------  describe "equivalentNameInNewMod" $ do-    it "finds equivalent name for normal import" $ do-      let-        ctc = cdAndDo "./test/testdata/cabal/foo"-      let-        comp = do-          parseSourceFileGhc "./src/Foo/Bar.hs"-          renamed <- getRefactRenamed-          let Just ((GHC.L _l old)) = locToName (3,1) renamed-          parseSourceFileGhc "./src/Main.hs"-          [equiv] <- equivalentNameInNewMod old-          return (old,equiv)--      ((o,e),_s) <- ctc $ runRefactGhc comp initialState testOptions-      (showGhcQual (o,e)) `shouldBe` "(Foo.Bar.bar, Foo.Bar.bar)"-      -- (showGhcQual (GHC.nameUnique o,GHC.nameUnique e)) `shouldBe` ""-      (GHC.nameUnique o == GHC.nameUnique e) `shouldBe` False--    -- -----------------------------------    it "finds equivalent name for qualified import" $ do-      let-        ctc = cdAndDo "./test/testdata/cabal/cabal4"-      let-        comp = do-          parseSourceFileGhc "./src/Foo/Bar.hs"-          renamed <- getRefactRenamed-          let Just ((GHC.L _l old)) = locToName (3,1) renamed-          parseSourceFileGhc "./src/main4.hs"-          [equiv] <- equivalentNameInNewMod old--          parsed <- getRefactParsed-          let Just ((GHC.L _l new)) = locToRdrName (11,12) parsed-          return (old,equiv,new)--      ((o,e,n),_s) <- ctc $ runRefactGhc comp initialState testOptions-      (showGhcQual (o,e,n)) `shouldBe` "(Foo.Bar.baz, Foo.Bar.baz, B.baz)"-      -- (showGhcQual (GHC.nameUnique o,GHC.nameUnique e)) `shouldBe` ""-      (GHC.nameUnique o == GHC.nameUnique e) `shouldBe` False--  -- -----------------------------------------------  describe "usedWithoutQualR" $ do-    it "Returns True if the identifier is used unqualified" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          parsed <- getRefactParsed--          let Just n@(GHC.L _ name) = locToName (14,21) renamed-          let res = usedWithoutQualR name parsed-          return (res,n,name)--      ((r,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (GHC.getOccString n2) `shouldBe` "zip"-      (showGhcQual n1) `shouldBe` "GHC.List.zip"-      r `shouldBe` True--    -- -----------------------------------    it "Returns False if the identifier is used qualified" $ do-      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          parsed <- getRefactParsed--          let Just n@(GHC.L _ name) = locToName (36,12) renamed-          let Just (GHC.L _ namep) = locToRdrName (36,12) parsed-          let res = usedWithoutQualR name parsed-          return (res,namep,name,n)-      ((r,np,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (myShow np) `shouldBe` "Qual:G:gshow"-      (myShow $ GHC.getRdrName n1) `shouldBe` "Exact:Data.Generics.Text.gshow"-      (showGhcQual $ GHC.getRdrName n1) `shouldBe` "Data.Generics.Text.gshow"-      (showGhcQual n2) `shouldBe` "Data.Generics.Text.gshow"-      r `shouldBe` False--  -- -----------------------------------------------  describe "isExplicitlyExported" $ do-    it "Returns True if the identifier is explicitly exported" $ do-      pending -- "write this "--    it "Returns False if the identifier is not explicitly exported" $ do-      pending -- "write this "--  -- -----------------------------------------------  describe "causeNameClashInExports" $ do-    it "Returns True if there is a clash" $ do--      t <- ct $ parsedFileGhc "./Renaming/ConflictExport.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t--      -- Is this the right module?-      let Just (modName,_) = getModuleName parsed--      let Just (GHC.L _ myFringe) = locToName (9,1) renamed-      (showGhcQual myFringe) `shouldBe` "Renaming.ConflictExport.myFringe"--      -- old name is myFringe-      -- new name is "Renaming.ConflictExport.fringe"-      let newName = mkTestGhcName 1 (Just modu) "fringe"--      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"-      (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringe"--      (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringe"--      let res = causeNameClashInExports myFringe newName modName renamed-      res `shouldBe` True--    it "Returns False if there is no clash" $ do-      t <- ct $ parsedFileGhc "./Renaming/ConflictExport.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t--      -- Is this the right module?-      let Just (modName,_) = getModuleName parsed--      let Just (GHC.L _ myFringe) = locToName (9,1) renamed-      (showGhcQual myFringe) `shouldBe` "Renaming.ConflictExport.myFringe"--      -- old name is myFringe-      -- new name is "Renaming.ConflictExport.fringe"-      let newName = mkTestGhcName 1 (Just modu) "fringeOk"--      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"-      (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringeOk"--      (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringeOk"--      let res = causeNameClashInExports myFringe newName modName renamed-      res `shouldBe` False--  -- -----------------------------------------  describe "rmQualifier" $ do-    it "removes the qualifiers from a list of identifiers in a given syntax phrase" $ do-      let-        comp = do-          parseSourceFileGhc "./TypeUtils/Qualified.hs"-          renamed <- getRefactRenamed-          parsed <- getRefactParsed-          decls <- liftT $ hsDecls parsed-          nm <- getRefactNameMap--          let Just (GHC.L _ foo) = locToName (5, 1) renamed-          let Just (GHC.L _ baz) = locToName (5, 27) renamed--          let [fooDecl] = definingDeclsRdrNames nm [foo] decls False False--          res <- rmQualifier [baz] fooDecl-          return (res,fooDecl,baz)--      ((r,d,n1),_s) <- ct $ runRefactGhc comp initialState  testOptions-      (showGhcQual n1) `shouldBe` "TypeUtils.C.baz"-      (showGhcQual d) `shouldBe` "main = return TypeUtils.C.baz"-      (showGhcQual r) `shouldBe` "main = return baz"--    it "Removes the qualifiers and updates the tokens" $ do-      pending -- "Is this needed?"--  -- -----------------------------------------  describe "usedByRhs" $ do-    it "returns True if a given identifier is used in the RHS of a syntax element" $ do-      t <- ct $ parsedFileGhc "./MoveDef/Demote.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          parsed <- getRefactParsed-          declsp <- liftT $ hsDecls parsed-          nm <- getRefactNameMap--          let Just (GHC.L _ tl)   = locToName (4,1) renamed-          let Just (GHC.L _ name) = locToName (7,1) renamed-          let decls = definingDeclsRdrNames nm [tl] declsp False False-          decls' <- rmQualifier [name] decls--          let res = usedByRhsRdr nm decls' [name]--          return (res,decls,tl,name)--      ((r,d,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n1) `shouldBe` "MoveDef.Demote.toplevel"-      (showGhcQual n2) `shouldBe` "MoveDef.Demote.c"-      (showGhcQual d) `shouldBe` "[toplevel x = c * x]"-      r `shouldBe` True--  -- -----------------------------------------  describe "autoRenameLocalVar" $ do-    it "renames an identifier if it is used and updates tokens" $ do-      t <- ct $ parsedFileGhc "./Demote/WhereIn4.hs"-      let-        comp = do-          renamed <- getRefactRenamed-          parsed <- getRefactParsed-          nm <- getRefactNameMap-          tlDecls <- liftT $ hsDecls parsed--          let Just (GHC.L _ tl)   = locToName (11,1) renamed-          let Just (GHC.L _ name) = locToName (11,21) renamed-          let [decls] = definingDeclsRdrNames nm [tl] tlDecls False True-          decls' <- autoRenameLocalVar name decls--          return (decls',decls,tl,name)--      ((r,d,n1,n2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((r,d,n1,n2),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions-      (showGhcQual n1) `shouldBe` "Demote.WhereIn4.sumSquares"-      (showGhcQual n2) `shouldBe` "p"-      (showGhcQual d) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"-      (showGhcQual r) `shouldBe` "sumSquares x y\n  = sq p_1 x + sq p_1 y\n  where\n      p_1 = 2"-      (exactPrintFromState s r) `shouldBe` "\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there is single matches), if possible,\n--the parameters will be folded after demoting and type sigature will be removed.\n\nsumSquares x y = sq p_1 x + sq p_1 y\n         where p_1=2"--  -- -----------------------------------------  describe "mkNewName" $ do-    it "Makes a new name that does not clash with existing ones" $ do-      (mkNewName "f" ["f"] 0) `shouldBe` "f_1"-      (mkNewName "f" ["g"] 0) `shouldBe` "f"-      (mkNewName "f" ["g","f_1","f"] 0) `shouldBe` "f_2"--  -- -----------------------------------------  describe "addImportDecl" $ do-    it "adds an import entry to a module with already existing, non conflicting imports and other declarations" $ do-      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let-        comp = do-         clearParsedModule-         parseSourceFileGhc "./DupDef/Dd2.hs"-         renamed2 <- getRefactRenamed-         parsed2 <- getRefactParsed--         let listModName  = GHC.mkModuleName "Data.List"-         res  <- addImportDecl parsed2 listModName Nothing False False False Nothing False []-         putRefactParsed res emptyAnns--         return (res,renamed2)-      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (sourceFromState s) `shouldBe` "module DupDef.Dd2 where\n\nimport DupDef.Dd1\nimport Data.List\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"--    -- -----------------------------------    it "adds an import entry to a module with some declaration, but no explicit imports." $ do-      t <- ct $ parsedFileGhc "./TypeUtils/Simplest.hs"-      let-        comp = do--         let renamed1 = fromJust $ GHC.tm_renamed_source t-         parsed <- getRefactParsed--         let listModName  = GHC.mkModuleName "Data.List"-         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []-         putRefactParsed res emptyAnns--         return (res,renamed1)-      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (sourceFromState s) `shouldBe` "module Simplest where\nimport Data.List\n\n\nsimple x = x\n"--    -- -----------------------------------    it "adds an import entry to a module with explicit imports, but no declarations." $ do-      t <- ct $ parsedFileGhc "./TypeUtils/JustImports.hs"-      let-        comp = do-         let renamed1 = fromJust $ GHC.tm_renamed_source t-         parsed <- getRefactParsed--         let listModName  = GHC.mkModuleName "Data.List"-         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []-         putRefactParsed res emptyAnns--         return (res,renamed1)-      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (sourceFromState s) `shouldBe` "module JustImports where\n\nimport Data.Maybe\nimport Data.List\n"--    -- -----------------------------------    it "adds an import entry to a module with no declarations and no explicit imports" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/Empty.hs"-      let-        comp = do-         renamed1 <- getRefactRenamed-         parsed <- getRefactParsed--         let listModName  = GHC.mkModuleName "Data.List"-         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []-         putRefactParsed res emptyAnns--         return (res,renamed1)-      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      (sourceFromState s) `shouldBe` "module Empty where\nimport Data.List\n\n"---  -- -----------------------------------------  describe "addItemsToImport" $ do-    it "adds an item to an import entry with no items" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/JustImports.hs"-      let-        comp = do-         parsed <- getRefactParsed--         let modName  = GHC.mkModuleName "Data.Maybe"-         -- itemName <- mkNewGhcName Nothing "fromJust"-         let  itemName = mkRdrName "fromJust"--         res  <- addItemsToImport modName parsed [itemName]-         putRefactParsed res emptyAnns--         return (res)-      ((_r),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions--      -- This is the correct behavior. If the import doesn't have an import list, creating-      -- one for an item effectively reduces the imported interface.-      (sourceFromState s) `shouldBe` "module JustImports where\n\nimport Data.Maybe\n"---- Not sure if this should be a test-{-    it "Try adding more than one item to an existing import entry with no items, using separate calls." $ do-      let-        comp = do-         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/JustImports.hs"-         -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1--         let modName  = GHC.mkModuleName "Data.Maybe"-         itemName <- mkNewGhcName Nothing "fromJust"--         res  <- addItemsToImport modName renamed1 [itemName] --listModName Nothing False False False Nothing False []--         itemName2 <- mkNewGhcName Nothing "isJust"--         res2 <- addItemsToImport modName res [itemName2]-         toks <- fetchToks--         return (res2,toks,renamed,_toks1)-      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp-      (GHC.showRichTokenStream t) `shouldBe` "module JustImports where\n\n import Data.Maybe (fromJust,isJust)\n "--}--    -- -----------------------------------    it "adds an item to an import entry with existing items" $ do-      t <- ct $ parsedFileGhc "./TypeUtils/SelectivelyImports.hs"-      let-        comp = do-         parsed <-getRefactParsed--         let modName  = GHC.mkModuleName "Data.Maybe"-         let  itemName = mkRdrName "isJust"--         res  <- addItemsToImport modName parsed [itemName]-         putRefactParsed res emptyAnns-         return (res)-      ((_r),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      (sourceFromState s) `shouldBe` "module SelectivelyImports where\n\nimport Data.Maybe (fromJust,isJust)\n\n__ = id\n"--{- -- test after properly inserting conditional identifier-    it "Add an item to an import entry with existing items, passing existing conditional identifier." $ do-      let-        comp = do-         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"-         -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1--         let modName  = GHC.mkModuleName "Data.Maybe"-         itemName <- mkNewGhcName Nothing "isJust"-         conditionalId <- mkNewGhcName Nothing "fromJust"--         res  <- addItemsToImport modName renamed1 [itemName] (Just conditionalId)-         toks <- fetchToks--         return (res,toks,renamed1,_toks1)-      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp-      (GHC.showRichTokenStream t) `shouldBe` "module SelectivelyImports where\n\n import Data.Maybe (fromJust,isJust)\n\n __ = id\n "--    it "Add an item to an import entry with existing items, passing missing conditional identifier" $ do-      let-        comp = do-         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"-         -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1--         let modName  = GHC.mkModuleName "Data.Maybe"-         itemName <- mkNewGhcName Nothing "isJust"--         res  <- addItemsToImport modName renamed1 [itemName] (Just itemName)-         toks <- fetchToks--         return (res,toks,renamed1,_toks1)-      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp-      (GHC.showRichTokenStream t) `shouldBe` "module SelectivelyImports where\n\n import Data.Maybe (fromJust)\n\n __ = id\n "--}--  -- -----------------------------------------  describe "hsValBinds" $ do-    it "returns ValBinds for RenamedSource" $ do-      t <- ct $ parsedFileGhc "./LiftOneLevel/D1.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let vb = hsValBinds renamed-      (showGhcQual vb) `shouldBe` "LiftOneLevel.D1.sumSquares (x : xs)\n  = sq x GHC.Num.+ LiftOneLevel.D1.sumSquares xs\n  where\n      sq x = x GHC.Real.^ pow\n      pow = 2\nLiftOneLevel.D1.sumSquares [] = 0\nLiftOneLevel.D1.main = LiftOneLevel.D1.sumSquares [1 .. 4]"--    -- -----------------------------------    it "returns ValBinds for (HsGroup Name)" $ do-      t <- ct $ parsedFileGhc "./LiftOneLevel/D1.hs"-      let (g,_,_,_) = fromJust $ GHC.tm_renamed_source t-      let vb = hsValBinds g-      (showGhcQual vb) `shouldBe` "LiftOneLevel.D1.sumSquares (x : xs)\n  = sq x GHC.Num.+ LiftOneLevel.D1.sumSquares xs\n  where\n      sq x = x GHC.Real.^ pow\n      pow = 2\nLiftOneLevel.D1.sumSquares [] = 0\nLiftOneLevel.D1.main = LiftOneLevel.D1.sumSquares [1 .. 4]"--  -- -----------------------------------------  describe "stripLeadingSpaces" $ do-    it "Strips the longest common space prefix from a list of Strings" $ do-      (stripLeadingSpaces []) `shouldBe` []-      (stripLeadingSpaces ["a"," b","  c"]) `shouldBe` ["a"," b","  c"]-      (stripLeadingSpaces [" a"," b","  c"]) `shouldBe` ["a","b"," c"]--  -- -----------------------------------------  describe "unspace" $ do-    it "Reduces all sequences of more than one space to a single one" $ do-      (unspace []) `shouldBe` []-      (unspace "a") `shouldBe` "a"-      (unspace "a bc") `shouldBe` "a bc"-      (unspace "a  bc") `shouldBe` "a bc"-      (unspace "ab   c") `shouldBe` "ab c"-      (unspace "  ab   c") `shouldBe` " ab c"-      (unspace "abc    ") `shouldBe` "abc "--  -- -----------------------------------------  describe "isFieldName" $ do-    it "returns True if a Name is a field name" $ do-      t <- ct $ parsedFileGhc "./Renaming/Field3.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ nf) = locToName (10,21) renamed-      let Just (GHC.L _ n) = locToName (10,1) renamed--      (showGhcQual n) `shouldBe` "Field3.absPoint"-      (showGhcQual nf) `shouldBe` "Field3.pointx"--  -- -----------------------------------------  describe "name predicates" $ do-    it "classifies names" $ do-      t <- ct $ parsedFileGhc "./Cons.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let Just (GHC.L _ n1) = locToName (3,6) renamed-      let Just (GHC.L _ n2) = locToName (3,12) renamed-      let Just (GHC.L _ n3) = locToName (3,16) renamed-      let Just (GHC.L _ n4) = locToName (5,1) renamed-      let Just (GHC.L _ n5) = locToName (8,5) renamed--      (showGhcQual n1) `shouldBe` "Main.Foo"-      "11" ++ (show $ GHC.isTyVarName n1)   `shouldBe` "11False"-      "12" ++ (show $ GHC.isTyConName n1)   `shouldBe` "12True"-      "13" ++ (show $ GHC.isDataConName n1) `shouldBe` "13False"-      "14" ++ (show $ GHC.isValName n1)     `shouldBe` "14False"-      "15" ++ (show $ GHC.isVarName n1)     `shouldBe` "15False"--      (showGhcQual n2) `shouldBe` "Main.Ff"-      "21" ++ (show $ GHC.isTyVarName n2)   `shouldBe` "21False"-      "22" ++ (show $ GHC.isTyConName n2)   `shouldBe` "22False"-      "23" ++ (show $ GHC.isDataConName n2) `shouldBe` "23True"-      "24" ++ (show $ GHC.isValName n2)     `shouldBe` "24True"-      "25" ++ (show $ GHC.isVarName n2)     `shouldBe` "25False"--      (showGhcQual n3) `shouldBe` "Main.fooA" -- field name-      "31" ++ (show $ GHC.isTyVarName n3)   `shouldBe` "31False"-      "32" ++ (show $ GHC.isTyConName n3)   `shouldBe` "32False"-      "33" ++ (show $ GHC.isDataConName n3) `shouldBe` "33False"-      "34" ++ (show $ GHC.isValName n3)     `shouldBe` "34True"-      "35" ++ (show $ GHC.isVarName n3)     `shouldBe` "35True"--      (showGhcQual n4) `shouldBe` "Main.xx"-      "41" ++ (show $ GHC.isTyVarName n4)   `shouldBe` "41False"-      "42" ++ (show $ GHC.isTyConName n4)   `shouldBe` "42False"-      "43" ++ (show $ GHC.isDataConName n4) `shouldBe` "43False"-      "44" ++ (show $ GHC.isValName n4)     `shouldBe` "44True"-      "45" ++ (show $ GHC.isVarName n4)     `shouldBe` "45True"--      (showGhcQual n5) `shouldBe` "GHC.Classes.=="-      "51" ++ (show $ GHC.isTyVarName n5)   `shouldBe` "51False"-      "52" ++ (show $ GHC.isTyConName n5)   `shouldBe` "52False"-      "53" ++ (show $ GHC.isDataConName n5) `shouldBe` "53False"-      "54" ++ (show $ GHC.isValName n5)     `shouldBe` "54True"-      "55" ++ (show $ GHC.isVarName n5)     `shouldBe` "55True"--  -- -----------------------------------------------------------------------  describe "rdrName2Name" $ do--    it "finds a Name for a top-level RdrName" $ do-      t <- ct $ parsedFileGhc "./TokenTest.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let-        comp = do-          let (Just rdr)  = locToRdrName (5,1) parsed-              (Just name) = locToName    (5,1) renamed-          nname <- rdrName2Name rdr-          return (rdr,name,nname)-      ((r,n,nn),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((r,n,nn),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual (r,n,nn)) `shouldBe` "(bob, TokenTest.bob, TokenTest.bob)"--    -- -----------------------------------    it "finds a Name for a local RdrName" $ do-      t <- ct $ parsedFileGhc "./TokenTest.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t--      let-        comp = do-          let (Just rdr)  = locToRdrName (14,7) parsed-              (Just name) = locToName    (14,7) renamed-          nname <- rdrName2Name rdr-          return (rdr,name,nname)-      ((r,n,nn),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions-      -- ((r,n,nn),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions--      (showGhcQual (r,n,nn)) `shouldBe` "(bar, bar, bar)"+{-# LANGUAGE CPP #-}+module TypeUtilsSpec (main, spec) where++import           Test.Hspec++import           TestUtils++import qualified GHC.SYB.Utils         as SYB++import qualified GHC        as GHC+import qualified GhcMonad   as GHC+import qualified Name       as GHC+import qualified RdrName    as GHC+import qualified Module     as GHC++import Data.Maybe++import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Parsers+import Language.Haskell.GHC.ExactPrint.Types++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.TypeUtils+import Language.Haskell.Refact.Utils.Utils+import Language.Haskell.Refact.Utils.Variables++import Data.List++main :: IO ()+main = do+  hspec spec++spec :: Spec+spec = do++  -- -------------------------------------------------------------------+{-+  describe "findAllNameOccurences" $ do+   it "finds all occurrences of the given name in a syntax phrase" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/S.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (4,5) parsed+      (showGhcQual n) `shouldBe` "x"++      let res = findAllNameOccurences n renamed+      (showGhcQual res) `shouldBe` "[x, x]"+      -- NOTE: does not get the x's in line 8+      (showGhcQual $ map startEndLocGhc res) `shouldBe` "[((4, 5), (4, 6)), ((4, 17), (4, 18))]"+-}+  -- -------------------------------------------------------------------++  describe "locToName" $ do+    it "returns a GHC.Name for a given source location, if it falls anywhere in an identifier #1" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just (res'@(GHC.L l _)) = locToRdrName (7,3) parsed+          n = rdrName2NamePure nm res'+          res = GHC.L l n+      showGhcQual l `shouldBe` "TypeUtils/B.hs:7:1-3"+      getLocatedStart res `shouldBe` (7,1)+      showGhcQual n `shouldBe` "TypeUtils.B.foo"++    -- ---------------------------------++    it "returns a GHC.Name for a given source location, if it falls anywhere in an identifier #2" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just (res'@(GHC.L l _)) = locToRdrName (25,8) parsed+          n = rdrName2NamePure nm res'+          res = GHC.L l n+      showGhcQual n `shouldBe` "TypeUtils.B.bob"+      showGhcQual l `shouldBe` "TypeUtils/B.hs:25:7-9"+      getLocatedStart res `shouldBe` (25,7)++    -- ---------------------------------++    it "returns Nothing for a given source location, if it does not fall in an identifier" $ do+      t <- ct $ parsedFileGhc "TypeUtils/B.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let res = locToNameRdrPure nm (7,7) parsed+      (showGhcQual res) `shouldBe` "Nothing"++    -- ---------------------------------++    it "gets a short name too" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn2.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just (res'@(GHC.L l _)) = locToRdrName (14,1) parsed+          n = rdrName2NamePure nm res'+          res = GHC.L l n+      showGhcQual n `shouldBe` "Demote.WhereIn2.sq"+      showGhcQual l `shouldBe` "Demote/WhereIn2.hs:14:1-2"+      getLocatedStart res `shouldBe` (14,1)++    -- ---------------------------------++    it "gets a type variable name" $ do+      t <- ct $ parsedFileGhc "./Renaming/ConstructorIn3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just (res'@(GHC.L l _)) = locToRdrName (9,12) parsed+          n = rdrName2NamePure nm res'+          res = GHC.L l n+      showGhcQual n `shouldBe` "a"+      -- Note: loc does not line up due to multiple matches in FunBind+      showGhcQual l `shouldBe` "Renaming/ConstructorIn3.hs:9:12"+      getLocatedStart res `shouldBe` (9,12)++    -- ---------------------------------++    it "gets an instance class name" $ do+      t <- ct $ parsedFileGhc "./Renaming/ClassIn3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just (res'@(GHC.L l _)) = locToRdrName (16,10) parsed+          n = rdrName2NamePure nm res'+          res = GHC.L l n+      showGhcQual n `shouldBe` "GHC.Classes.Eq"+      showGhcQual l `shouldBe` "Renaming/ClassIn3.hs:16:10-11"+      getLocatedStart res `shouldBe` (16,10)++  -- -------------------------------------------------------------------++  describe "locToRdrName" $ do+    it "returns a GHC.RdrName for a given source location, if it falls anywhere in an identifier" $ do+      t <- ct $ parsedFileGhc "./Renaming/D5.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just (res@(GHC.L l n)) = locToRdrName (20,1) parsed+      (show $ ss2span l) `shouldBe` "((20,1),(20,11))"+      getLocatedStart res `shouldBe` (20,1)+      showGhcQual n `shouldBe` "sumSquares"++    it "returns a GHC.RdrName for a source location, in a MatchGroup" $ do+      t <- ct $ parsedFileGhc "./LocToName.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just (res@(GHC.L l n)) = locToRdrName (24,2) parsed+      showGhcQual n `shouldBe` "sumSquares"+      getLocatedStart res `shouldBe` (24,1)+      showGhcQual l `shouldBe` "LocToName.hs:24:1-10"++  -- -------------------------------------------------------------------++  describe "getName" $ do+    it "gets a qualified Name at the top level" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let Just n = getName "TypeUtils.B.foo'" renamed+      (showGhcQual n) `shouldBe` "TypeUtils.B.foo'"+      (showGhcQual $ GHC.getSrcSpan n) `shouldBe` "TypeUtils/B.hs:14:1-4"++    it "gets any instance of an unqualified Name" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let Just n = getName "foo" renamed+      (showGhcQual n) `shouldBe` "foo"+      (showGhcQual $ GHC.getSrcSpan n) `shouldBe` "TypeUtils/B.hs:9:15-17"++    it "returns Nothing if the Name is not found" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/B.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let res = getName "baz" renamed+      (showGhcQual res) `shouldBe` "Nothing"++  -- -------------------------------------------------------------------++  describe "definingDeclsRdrNames" $ do+    it "returns [] if not found" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (16,6) parsed+      let decls = GHC.hsmodDecls $ GHC.unLoc parsed+      let res = definingDeclsRdrNames nm [n] decls False False+      showGhcQual res `shouldBe` "[]"++    -- ---------------------------------++    it "finds declarations at the top level" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (3,3) parsed+      let decls = GHC.hsmodDecls $ GHC.unLoc parsed+      let res = definingDeclsRdrNames nm [n] decls False False+      showGhcQual res `shouldBe` "[toplevel x = c * x]"++    -- ---------------------------------++    it "finds declarations not at the top level 1" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn6.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (13,29) parsed+      let decls = GHC.hsmodDecls $ GHC.unLoc parsed+      let res = definingDeclsRdrNames nm [n] decls False True+      showGhcQual n `shouldBe` "pow"+      showGhcQual res `shouldBe` "[pow = 2]"++    -- ---------------------------------++    it "finds declarations not at the top level 2" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/LetIn1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (11,22) parsed+      let decls = GHC.hsmodDecls $ GHC.unLoc parsed+      let res = definingDeclsRdrNames nm [n] decls False True+      showGhcQual n `shouldBe` "sq"+      showGhcQual res `shouldBe` "[sq 0 = 0\n sq z = z ^ pow]"++    -- ---------------------------------++    it "finds in a patbind" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (14,1) parsed+      let decls = GHC.hsmodDecls $ GHC.unLoc parsed+      let res = definingDeclsRdrNames nm [n] decls False False+      showGhcQual res `shouldBe` "[tup@(h, t)\n   = head $ zip [1 .. 10] [3 .. ff]\n   where\n       ff :: Int\n       ff = 15]"++    -- ---------------------------------++    it "finds recursively in sub-binds" $ do+      {-+      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let res = definingDecls [(PN (mkRdrName "zz"))] ds False True+      showGhcQual res `shouldBe` "[zz n = n + 1]" -- TODO: Currently fails, will come back to it+      -}+      pending -- "Currently fails, will come back to it"++    -- ---------------------------------++    it "only finds recursively in sub-binds if asked" $ do+      {-+      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let res = definingDecls [(PN (mkRdrName "zz"))] ds False False+      showGhcQual res `shouldBe` "[]"+      -}+      pending -- "Convert to definingDeclsNames"++  -- -------------------------------------------------------------------+{-+  describe "definingDeclsNames" $ do+    it "returns [] if not found" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (16,6) parsed+      let res = definingDeclsNames [n] (hsBinds renamed) False False+      showGhcQual res `shouldBe` "[]"++    it "finds declarations at the top level" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (3,3) parsed+      let res = definingDeclsNames [n] (hsBinds renamed) False False+      showGhcQual res `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"+++    it "finds in a patbind" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (14,1) parsed+      let res = definingDeclsNames [n] (hsBinds renamed) False False+      showGhcQual res `shouldBe` "[DupDef.Dd1.tup@(DupDef.Dd1.h, DupDef.Dd1.t)\n   = GHC.List.head GHC.Base.$ GHC.List.zip [1 .. 10] [3 .. ff]\n   where\n       ff :: GHC.Types.Int\n       ff = 15]"+++    it "finds recursively in sub-binds" $ do+      {-+      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let res = definingDecls [(PN (mkRdrName "zz"))] ds False True+      showGhcQual res `shouldBe` "[zz n = n + 1]" -- TODO: Currently fails, will come back to it+      -}+      pending -- "Currently fails, will come back to it"++    it "only finds recursively in sub-binds if asked" $ do+      {-+      modInfo@((_, _, mod@(GHC.L l (GHC.HsModule name exps imps ds _ _))), toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let res = definingDecls [(PN (mkRdrName "zz"))] ds False False+      showGhcQual res `shouldBe` "[]"+      -}+      pending -- "Convert to definingDeclsNames"+-}+  -- -------------------------------------------------------------------++  describe "definingSigsRdrNames" $ do+    it "returns [] if not found" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (21,1) parsed+      showGhcQual n `shouldBe` "DupDef.Dd1.ff"+      let res = definingSigsRdrNames nm [n] parsed+      showGhcQual res `shouldBe` "[]"++    -- ---------------------------------++    it "finds signatures at the top level" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (4,1) parsed+      showGhcQual n `shouldBe` "DupDef.Dd1.toplevel"+      let res = definingSigsRdrNames nm [n] parsed+      showGhcQual res `shouldBe` "[toplevel :: Integer -> Integer]"++    -- ---------------------------------++    it "returns only the single signature where there are others too" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7,1) parsed+      showGhcQual n `shouldBe` "DupDef.Dd1.c"+      let res = definingSigsRdrNames nm [n] parsed+      showGhcQual res `shouldBe`  "[c :: Integer]"++    -- ---------------------------------++    it "finds signatures at lower levels" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (16,5) parsed+      showGhcQual n `shouldBe` "ff"+      let res = definingSigsRdrNames nm [n] parsed+      showGhcQual res `shouldBe` "[ff :: Int]"++    -- ---------------------------------++    it "finds multiple signatures 1" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n1 = locToNameRdrPure nm (21,1) parsed+      showGhcQual n1 `shouldBe` "DupDef.Dd1.ff"++      let Just n2 = locToNameRdrPure nm (16,5) parsed+      showGhcQual n2 `shouldBe` "ff"++      let Just n3 = locToNameRdrPure nm (4,1) parsed+      showGhcQual n3 `shouldBe` "DupDef.Dd1.toplevel"++      let res = definingSigsRdrNames nm [n1,n2,n3] parsed+      showGhcQual res `shouldBe` "[toplevel :: Integer -> Integer, ff :: Int]"++    -- ---------------------------------++    it "finds multiple signatures 2" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n1 = locToNameRdrPure nm (14,1) parsed+      showGhcQual n1 `shouldBe` "DupDef.Dd1.tup"++      let Just n2 = locToNameRdrPure nm (14,6) parsed+      showGhcQual n2 `shouldBe` "DupDef.Dd1.h"++      let Just n3 = locToNameRdrPure nm (14,8) parsed+      showGhcQual n3 `shouldBe` "DupDef.Dd1.t"++      let res = definingSigsRdrNames nm [n1,n2,n3] parsed+      showGhcQual res `shouldBe` "[tup :: (Int, Int), h :: Int, t :: Int]"++  -- -------------------------------------------------------------------++  describe "definingTyClDeclsNames" $ do+    it "returns [] if not found" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (10,29) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      showGhcQual res `shouldBe` "[]"++    -- ---------------------------------++    it "finds foreign type declarations" $ do+      pending++    -- ---------------------------------++    it "finds family declarations" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      -- putStrLn $ "parsed:" ++ SYB.showData SYB.Parser 0 parsed++      let Just n = locToNameRdrPure nm (7,14) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      showGhcQual res `shouldBe` "[data family XList a]"++    -- ---------------------------------++    it "finds data declarations" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (12,6) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      (unspace $ showGhcQual res) `shouldBe` "[data Foo = Foo Int]"++    -- ---------------------------------++    it "finds type declarations" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (14,6) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      showGhcQual res `shouldBe` "[type Foo2 = String]"++    -- ---------------------------------++    it "finds class declarations" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (16,7) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      showGhcQual res `shouldBe` "[class Bar a where\n   bar :: a -> Bool]"++    -- ---------------------------------++    it "finds multiple declarations" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n1 = locToNameRdrPure nm (14,6) parsed+      let Just n2 = locToNameRdrPure nm (16,7) parsed+      let res = definingTyClDeclsNames nm [n1,n2] parsed+      showGhcQual res `shouldBe` "[type Foo2 = String,\n class Bar a where\n   bar :: a -> Bool]"+++  -- -------------------------------------------------------------------++  describe "isFunBindR" $ do+    it "Returns False if not a function definition" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let decls = getHsDecls parsed+      let Just tup = getName "DupDef.Dd1.tup" renamed+      let [GHC.L l (GHC.ValD decl)] = definingDeclsRdrNames nm [tup] decls False False+      isFunBindR (GHC.L l decl)  `shouldBe` False++    it "Returns True if a function definition" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let (GHC.L _l (GHC.HsModule _name _exps _imps _ds _ _)) = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just toplevel = getName "DupDef.Dd1.toplevel" renamed+      let [GHC.L l (GHC.ValD decl)] = definingDeclsRdrNames nm [toplevel] (getHsDecls parsed) False False+      isFunBindR (GHC.L l decl)  `shouldBe` True++  -- -------------------------------------------------------------------++  describe "isFunOrPatName" $ do+    it "return True if a PName is a function/pattern name defined in t" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed  = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      -- putStrLn $ "parsed:\n" ++ SYB.showData SYB.Parser 0 parsed+      let Just tup = getName "DupDef.Dd1.tup" renamed+      (showGhcQual tup) `shouldBe` "DupDef.Dd1.tup"+      isFunOrPatName nm tup parsed  `shouldBe` True++    -- ---------------------------------++    it "return False if a PName is a function/pattern name defined in t" $ do+      t  <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      t2 <- ct $ parsedFileGhc "./DupDef/Dd2.hs"+      let renamed  = fromJust $ GHC.tm_renamed_source t+      let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2+          nm2 = initRdrNameMap t2++      let Just tup = getName "DupDef.Dd1.tup" renamed+      isFunOrPatName nm2 tup parsed2  `shouldBe` False+++  -- -------------------------------------------------------------------++  describe "hsFreeAndDeclaredXXXX" $ do++    it "finds declared in type class definitions" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareTypes.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          tdss <- mapM getDeclaredTypesRdr decls+          let tds = nub $ concat tdss+          return (tds)+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((res),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (res)) `shouldBe`+          "[(FreeAndDeclared.DeclareTypes.XList, (8, 1)),\n"+++          " (FreeAndDeclared.DeclareTypes.X, (19, 1)),\n"+++          " (FreeAndDeclared.DeclareTypes.Y, (19, 10)),\n"+++          " (FreeAndDeclared.DeclareTypes.Z, (19, 22)),\n"+++          " (FreeAndDeclared.DeclareTypes.W, (19, 26)),\n"+++          " (FreeAndDeclared.DeclareTypes.Foo, (21, 1)),\n"+++          " (FreeAndDeclared.DeclareTypes.Bar, (23, 1)),\n"+++          " (FreeAndDeclared.DeclareTypes.doBar, (27, 3)),\n"+++          " (FreeAndDeclared.DeclareTypes.BarVar, (24, 3)),\n"+++          " (FreeAndDeclared.DeclareTypes.BarData, (25, 3))]"++    -- ---------------------------------++    it "finds declared HsVar" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          logDataWithAnns "parsed:"  parsed+          let rr = hsFreeAndDeclaredRdr nm parsed+          rg <-    hsFreeAndDeclaredPNs    parsed+          return (rg,rr)+      -- ((resg,(FN fr,DN dr)),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((resg,(FN fr,DN dr)),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      -- ---------------------+      -- Free Vars - parsed+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) fr) `shouldBe`+                   "[(GHC.Integer.Type.Integer, (-1, -1)), "+++                   "(GHC.Num.*, (-1, -1)),\n "+++                   "(GHC.Types.Int, (-1, -1)), "+++                   "(GHC.Base.$, (-1, -1)),\n "+++                   "(GHC.List.head, (-1, -1)), "+++                   "(GHC.List.zip, (-1, -1)),\n "+++                   "(System.IO.getChar, (-1, -1)), "+++                   "(System.IO.putStrLn, (-1, -1)),\n "+++                   "(Data.Generics.Text.gshow, (-1, -1))]"++      -- Declared Vars - parsed+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) dr) `shouldBe`+                   "[(FreeAndDeclared.Declare.toplevel, (6, 1)),\n "+++                   "(FreeAndDeclared.Declare.c, (9, 1)),\n "+++                   "(FreeAndDeclared.Declare.d, (10, 1)),\n "+++                   "(FreeAndDeclared.Declare.tup, (16, 1)),\n "+++                   "(FreeAndDeclared.Declare.h, (16, 6)),\n "+++                   "(FreeAndDeclared.Declare.t, (16, 8)),\n "+++                   "(FreeAndDeclared.Declare.D, (18, 1)),\n "+++                   "(FreeAndDeclared.Declare.A, (18, 10)),\n "+++                   "(FreeAndDeclared.Declare.B, (18, 14)),\n "+++                   "(FreeAndDeclared.Declare.C, (18, 25)),\n "+++                   "(FreeAndDeclared.Declare.unD, (21, 1)),\n "+++                   "(FreeAndDeclared.Declare.F, (25, 1)),\n "+++                   "(FreeAndDeclared.Declare.G, (25, 10)),\n "+++                   "(FreeAndDeclared.Declare.:|, (25, 14)),\n "+++                   "(FreeAndDeclared.Declare.unF, (27, 1)),\n "+++                   "(FreeAndDeclared.Declare.main, (30, 1)),\n "+++                   "(FreeAndDeclared.Declare.mkT, (34, 1)),\n "+++                   "(FreeAndDeclared.Declare.ff, (36, 1))]"++      -- ---------------------+      -- GHC version+      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(GHC.Integer.Type.Integer, (-1, -1)), "+++                   "(GHC.Num.*, (-1, -1)),\n "+++                   "(GHC.Types.Int, (-1, -1)), "+++                   "(GHC.Base.$, (-1, -1)),\n "+++                   "(GHC.List.head, (-1, -1)), "+++                   "(GHC.List.zip, (-1, -1)),\n "+++                   "(System.IO.getChar, (-1, -1)), "+++                   "(System.IO.putStrLn, (-1, -1)),\n "+++                   "(Data.Generics.Text.gshow, (-1, -1))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                  "[(FreeAndDeclared.Declare.toplevel, (6, 1)),\n "+++                  "(FreeAndDeclared.Declare.c, (9, 1)),\n "+++                  "(FreeAndDeclared.Declare.d, (10, 1)),\n "+++                  "(FreeAndDeclared.Declare.tup, (16, 1)),\n "+++                  "(FreeAndDeclared.Declare.h, (16, 6)),\n "+++                  "(FreeAndDeclared.Declare.t, (16, 8)),\n "+++                  "(FreeAndDeclared.Declare.D, (18, 1)),\n "+++                  "(FreeAndDeclared.Declare.A, (18, 10)),\n "+++                  "(FreeAndDeclared.Declare.B, (18, 14)),\n "+++                  "(FreeAndDeclared.Declare.C, (18, 25)),\n "+++                  "(FreeAndDeclared.Declare.unD, (21, 1)),\n "+++                  "(FreeAndDeclared.Declare.F, (25, 1)),\n "+++                  "(FreeAndDeclared.Declare.G, (25, 10)),\n "+++                  "(FreeAndDeclared.Declare.:|, (25, 14)),\n "+++                  "(FreeAndDeclared.Declare.unF, (27, 1)),\n "+++                  "(FreeAndDeclared.Declare.main, (30, 1)),\n "+++                  "(FreeAndDeclared.Declare.mkT, (34, 1)),\n "+++                  "(FreeAndDeclared.Declare.ff, (36, 1))]"+++    -- ---------------------------------++    it "finds free and declared in a single bind PrefixCon" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"+      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          -- let b = head $ drop 4 $ hsBinds renamed+          let b = head $ drop 10 $ decls+          rg <- hsFreeAndDeclaredPNs [b]+          return (b,rg)+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual bb) `shouldBe` "unD (B y) = y"+      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- GHC version+      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(FreeAndDeclared.Declare.B, (18, 14))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(FreeAndDeclared.Declare.unD, (21, 1))]"++    -- ---------------------------------++    it "finds free and declared in a single bind InfixCon" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          -- let b = head $ drop 3 $ hsBinds renamed+          let b = head $ drop 12 $ decls+          rg <- hsFreeAndDeclaredPNs [b]+          return (b,rg)+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual bb) `shouldBe` "unF (a :| b) = (a, b)"+      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- GHC version+      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(FreeAndDeclared.Declare.:|, (25, 14))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(FreeAndDeclared.Declare.unF, (27, 1))]"++    -- ---------------------------------++    it "finds free and declared in a single bind RecCon" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareRec.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          -- let b = head $ drop 0 $ hsBinds renamed+          let b = head $ drop 2 decls+          rg <- hsFreeAndDeclaredPNs [b]+          return (b,rg)+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual bb) `shouldBe` "unR2 (RCon {r1 = a}) = a"+      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- GHC version+      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(FreeAndDeclared.DeclareRec.RCon, (3, 10))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(FreeAndDeclared.DeclareRec.unR2, (7, 1))]"++    -- -----------------------------------------------------------------++    it "hsFreeAndDeclaredPNs simplest" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareS.hs"+      let+        comp = do+          parsed <- getRefactParsed+          r <- hsFreeAndDeclaredPNs parsed+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe` "[]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe` "[(FreeAndDeclared.DeclareS.c, (6, 1))]"++    -- -----------------------------------------------------------------++    it "finds free and declared in a single bind #2" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t++      let Just tup = getName "DupDef.Dd1.ff" renamed++      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [tup] decls False False+          r <- hsFreeAndDeclaredPNs [decl]+          return (r,decl)+      ((res,d),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual d) `shouldBe` "ff y\n  = y + zz\n  where\n      zz = 1"+      -- (SYB.showData SYB.Renamer 0 d) `shouldBe` ""++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`+                   "[(GHC.Num.+, (-1, -1))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`+                   "[(DupDef.Dd1.ff, (21, 1))]"++    -- -----------------------------------------------------------------++    it "finds free and declared at the top level 1" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn1.hs"++      let+        comp = do+          parsed <- getRefactParsed+          -- r <- hsFreeAndDeclaredPNs $ hsBinds renamed+          r <- hsFreeAndDeclaredPNs parsed+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`+                   "[(LiftToToplevel.WhereIn1.sumSquares, (9, 1)),\n "+++                   "(LiftToToplevel.WhereIn1.anotherFun, (15, 1))]"++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`+                   "[(GHC.Num.+, (-1, -1)), (GHC.Real.^, (-1, -1))]"++    -- -----------------------------------------------------------------++    it "finds free and declared at the top level 2" $ do+      t <- ct $ parsedFileGhc "./Renaming/IdIn3.hs"++      let+        comp = do+          parsed <- getRefactParsed+          r <- hsFreeAndDeclaredPNs parsed+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`+                  "[(IdIn3.x, (10, 1)), "+++                  "(IdIn3.foo, (12, 1)), "+++                  "(IdIn3.bar, (14, 1)),\n "+++                  "(IdIn3.main, (18, 1))]"++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`+                   "[(GHC.Num.+, (-1, -1))]"++    -- -----------------------------------------------------------------++    it "finds free and declared in a GRHSs" $ do+      t <- ct $ parsedFileGhc "./LiftOneLevel/LetIn2.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t++      let Just tup = getName "LiftOneLevel.LetIn2.sumSquares" renamed+      let+        comp = do+          nm <- getRefactNameMap+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [tup] decls False False++#if __GLASGOW_HASKELL__ <= 710+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG [match] _ _ _) _ _ _))) = decl+#else+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ (GHC.MG (GHC.L _ [match]) _ _ _) _ _ _))) = decl+#endif+          let (GHC.L _ (GHC.Match _ _pat _ grhss)) = match++          r <- hsFreeAndDeclaredPNs grhss+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe`+                   "[]"++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst res)) `shouldBe`+                   "[(GHC.Real.^, (-1, -1)), (GHC.Num.+, (-1, -1)), (x, (10, 12)),\n (y, (10, 14))]"++    -- -----------------------------------------------------------------++    it "finds free and declared in a single bind" $ do+      pending -- "fix the prior test"++  -- ---------------------------------------------------------------------+++  describe "hsFDsFromInsideRdr" $ do+    it "does something useful" $ do+      pendingWith "need to convert to using Parsed source" -- "Complete this"++  describe "hsFDsFromInside" $ do+    it "does something useful" $ do+      pending -- "Complete this"++  describe "hsFDNamesFromInside" $ do+    it "does something useful" $ do+      pending -- "Complete this"++  -- ---------------------------------------------------------------------++  describe "hsVisibleNames" $ do+    it "does something useful" $ do+      pending -- "Complete this"++  -- ---------------------------------------------------------------------++  describe "hsVisibleDsRdr" $ do++    -- ---------------------------------++    it "returns [] if e does not occur in t" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just tl1  = locToExp (4,13) (4,40) parsed :: (Maybe (GHC.Located (GHC.HsExpr GHC.RdrName)))+      let Just tup = getName "DupDef.Dd1.tup" renamed+      let+        comp = do+          DN r <- hsVisibleDsRdr nm tup tl1+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (null res) `shouldBe` True++    -- -----------------------------------------------------------------++    it "returns visible vars if e does occur in t #1" $ do+      pendingWith "no longer relevant?"+{-+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just tl1  = locToExp (28,4) (28,12) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual tl1) `shouldBe` "ll + z"++      let Just tup = getName "DupDef.Dd1.l" renamed++      let+        comp = do+         decls <- liftT $ hsDecls parsed+         let [decl] = definingDeclsRdrNames nm [tup] decls False False+         r <- hsVisibleDsRdr nm (rdrName2NamePure nm tl1) decl+         return (r,decl)+      ((res,d),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual d) `shouldBe` "l z = let ll = 34 in ll + z"+      (showGhcQual res ) `shouldBe` "[z, ll]"+      -- (showGhcQual res2 ) `shouldBe` "[z, ll]"+-}+    -- -----------------------------------------------------------------++    it "returns visible vars if e does occur in t #2" $ do+      pendingWith "no longer relevant?"+ {-+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just tl1  = locToExp (28,4) (28,12) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual tl1) `shouldBe` "ll + z"++      let Just rhs  = locToExp (26,1) (28,12) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual rhs) `shouldBe` "let ll = 34 in ll + z"++      let+        comp = do+          r <- hsVisibleDsRdr nm (rdrName2NamePure nm tl1) rhs+          return r+      ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual res) `shouldBe` "[ll]"+-}+    -- ---------------------------------++    it "Rdr:finds function arguments visible in RHS 1" $ do+      pendingWith "no longer relevant?"+  {-+      t <- ct $ parsedFileGhc "./Visible/Simple.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just e  = locToExp (5,11) (5,19) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual e) `shouldBe` "a + b"++      let Just n = getName "Visible.Simple.params" renamed++      let+        comp = do+          nm <- getRefactNameMap+          declsp <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] declsp False False+          fds' <- hsVisibleDsRdr nm (rdrName2NamePure nm e) decl+          return (fds')+      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe` "DN [a, b, GHC.Num.+]"+-}+    -- -----------------------------------++    it "finds function arguments visible in RHS 2" $ do+      pendingWith "no longer relevant?"+   {-+      t <- ct $ parsedFileGhc "./Visible/Simple.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""++      let Just e   = locToExp (9,15) (9,17) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual e) `shouldBe` "x"++      let Just n = getName "Visible.Simple.param2" renamed++      let+        comp = do+          nm <- getRefactNameMap+          declsp <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] declsp False False+          fds' <- hsVisibleDsRdr nm (rdrName2NamePure nm e) decl+          return (fds')+      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe` "DN [x]"+-}+    -- -----------------------------------++    it "finds visible vars inside a function" $ do+      t <- ct $ parsedFileGhc "./Renaming/IdIn5.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just rhs  = locToExp (14,6) (15,14) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))+      (showGhcQual rhs) `shouldBe` "x + y + z"++      -- let Just er = getName "IdIn5.x" renamed+      let Just e  = locToRdrName (14,7) parsed+      (showGhcQual e) `shouldBe` "x"+      (SYB.showData SYB.Parser 0 e) `shouldBe` "\n(L {Renaming/IdIn5.hs:14:7} \n (Unqual {OccName: x}))"++      let+        comp = do+          nm <- getRefactNameMap+          fds' <- hsVisibleDsRdr nm (rdrName2NamePure nm e) rhs+          -- ffds <- hsFreeAndDeclaredGhc rhsr+          let ffds = hsFreeAndDeclaredRdr nm rhs+          return (fds',ffds)+      -- ((fds,_fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show _fds) `shouldBe` "(FN [GHC.Num.+, IdIn5.x, y, z],DN [])"+      (show fds)  `shouldBe` "DN [GHC.Num.+, IdIn5.x, y, z]"++    -- -----------------------------------++    it "finds visible vars inside a data declaration" $ do+      t <- ct $ parsedFileGhc "./Renaming/D1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just ln = locToRdrName (6, 6) parsed+      (showGhcQual ln) `shouldBe` "Tree"+      (SYB.showData SYB.Parser 0 ln) `shouldBe` "\n(L {Renaming/D1.hs:6:6-9} \n (Unqual {OccName: Tree}))"++      let+        comp = do+          -- logDataWithAnns "parsed" parsed+          nm <- getRefactNameMap+          fds' <- hsVisibleDsRdr nm (rdrName2NamePure nm ln) parsed+          -- ffds <- hsFreeAndDeclaredGhc renamed+          let ffds = hsFreeAndDeclaredRdr nm parsed+          return (fds',ffds)+      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((fds,_fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (show _fds) `shouldBe` "(FN [a, "+++                                  "GHC.Base.++, "+++                                  "GHC.Types.Int, "+++                                  "GHC.Classes.==, "+++                                  "GHC.Classes./=, "+++                                  ":,\n "+++                                  "GHC.Num.+, "+++                                  "GHC.Real.^, "+++                                  "[]],"+++                             "DN [Renaming.D1.Tree, "+++                                 "Renaming.D1.Leaf, "+++                                 "Renaming.D1.Branch,\n "+++                                 "Renaming.D1.fringe, "+++                                 "Renaming.D1.SameOrNot, "+++                                 "Renaming.D1.isSame,\n "+++                                 "Renaming.D1.isNotSame, "+++                                 "Renaming.D1.sumSquares])"++      (show fds) `shouldBe` "DN [Renaming.D1.Tree, Renaming.D1.Leaf, Renaming.D1.Branch]"++    -- -----------------------------------++    it "finds visible vars inIdIn5" $ do+      t <- ct $ parsedFileGhc "./Renaming/IdIn5.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just ln = locToRdrName (10, 1) parsed+      (showGhcQual ln) `shouldBe` "x"+      (SYB.showData SYB.Parser 0 ln) `shouldBe` "\n(L {Renaming/IdIn5.hs:10:1} \n (Unqual {OccName: x}))"++      let+        comp = do+          logDataWithAnns "parsed" parsed+          nm <- getRefactNameMap+          fds' <- hsVisibleDsRdr nm (rdrName2NamePure nm ln) parsed+          let ffds = hsFreeAndDeclaredRdr nm parsed+          return (fds',ffds)+      ((fds,_fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((fds,_fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (show _fds) `shouldBe` "(FN [GHC.Num.+],"+++                              "DN [IdIn5.x, IdIn5.foo, IdIn5.bar, IdIn5.main])"++      (show fds) `shouldBe` "DN [GHC.Num.+, IdIn5.x, z, y, IdIn5.foo, IdIn5.bar]"+++  -- ---------------------------------------------------------------------++  describe "hsFreeAndDeclaredRdr" $ do+    it "finds function arguments visible in RHS fd" $ do+      t <- ct $ parsedFileGhc "./Visible/Simple.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just e  = locToExp (5,11) (5,19) parsed :: (Maybe (GHC.Located (GHC.HsExpr GHC.RdrName)))+      (showGhcQual e) `shouldBe` "a + b"++      let Just n = getName "Visible.Simple.params" renamed++      let+        comp = do+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] decls False False+          let fds' = hsFreeAndDeclaredRdr nm decl+          return (fds')+      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe` "(FN [GHC.Num.+],DN [Visible.Simple.params])"++    -- -----------------------------------++    it "finds function arguments and free vars visible in RHS" $ do+      t <- ct $ parsedFileGhc "./Visible/Simple.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just e  = locToExp (9,15) (9,17) parsed :: Maybe (GHC.LHsExpr GHC.RdrName)+      (showGhcQual e) `shouldBe` "x"++      let Just n = getName "Visible.Simple.param2" renamed+      let+        comp = do+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] decls False False++#if __GLASGOW_HASKELL__ <= 710+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG matches _ _ _) _ _ _))) = decl+#else+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ (GHC.MG (GHC.L _ matches) _ _ _) _ _ _))) = decl+#endif+          let [(GHC.L _ (GHC.Match _ pats _ _))] = matches+          let lpat = head pats+          logDataWithAnns "lpat" lpat++          -- fds' <- hsFreeAndDeclaredGhc $ lpat+          let fds' = hsFreeAndDeclaredRdr nm lpat+          return (fds')+      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe` "(FN [Visible.Simple.B],DN [x])"++    -- -----------------------------------++    it "finds imported functions used in the rhs" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let Just n = getName "FreeAndDeclared.Declare.tup" renamed++      let+        comp = do+          nm <- getRefactNameMap+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] decls False False+          let fds' = hsFreeAndDeclaredRdr nm decl+          return (fds')+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe`+            "(FN [GHC.Base.$, GHC.List.head, GHC.List.zip],"+++            "DN [FreeAndDeclared.Declare.tup, FreeAndDeclared.Declare.h,\n "+++                "FreeAndDeclared.Declare.t])"++    -- -----------------------------------++    it "finds free vars in HsWithBndrs" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Binders.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t++      let Just n = getName "FreeAndDeclared.Binders.findNewPName" renamed+      let+        comp = do+          nm <- getRefactNameMap+          parsed <- getRefactParsed+          -- logDataWithAnns "parsed" parsed+          decls <- liftT $ hsDecls parsed+          let [decl] = definingDeclsRdrNames nm [n] decls False False+#if __GLASGOW_HASKELL__ <= 710+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG [match] _ _ _) _ _ _))) = decl+#else+          let (GHC.L _ (GHC.ValD (GHC.FunBind _ (GHC.MG (GHC.L _ [match]) _ _ _) _ _ _))) = decl+#endif+          let (GHC.L _ (GHC.Match _ _pats _rhs binds)) = match++          logDataWithAnns "binds" binds+          -- fds' <- hsFreeAndDeclaredGhc $ binds+          let fds' = hsFreeAndDeclaredRdr nm binds+          return (fds')+      -- ((fds),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((fds),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe`+            "(FN [FreeAndDeclared.Binders.gfromJust,\n "+++            "FreeAndDeclared.Binders.somethingStaged,\n "+++            "FreeAndDeclared.Binders.Renamer, "+++            "GHC.Base.Nothing, "+++            "renamed,\n "+++            "FreeAndDeclared.Binders.Name, "+++            "GHC.Classes.==, "+++            "GHC.Base.$,\n "+++            "FreeAndDeclared.Binders.occNameString,\n "+++            "FreeAndDeclared.Binders.getOccName, "+++            "name, "+++            "GHC.Base.Just],"+++            "DN [res, worker])"++    -- -----------------------------------++    it "finds free vars in TH files" $ do+      t <- ct $ parsedFileGhc "./TH/Main.hs"+      let+        comp = do+          parseSourceFileGhc "./TH/Main.hs"+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          let fds' = hsFreeAndDeclaredRdr nm parsed+          return (fds')+      ((fds),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (show fds) `shouldBe`+            "(FN [System.IO.putStrLn, pr],"+++             "DN [TH.Main.main, TH.Main.baz, TH.Main.sillyString])"++  -- ---------------------------------------------++  describe "isLocalPN" $ do+    it "returns True if the name is local to the module" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (17, 5) parsed+      (showGhcQual n) `shouldBe` "ff"+      isLocalPN n `shouldBe` True++    it "returns False if the name is not local to the module" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (21, 1) parsed+      (showGhcQual n) `shouldBe` "DupDef.Dd1.ff"+      isLocalPN n `shouldBe` False++  -- ---------------------------------------------++  describe "isTopLevelPN" $ do+    it "returns False if the name is not defined at the top level of the module" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          let Just n = locToNameRdrPure nm (17, 5) parsed+          topLevel <- isTopLevelPN n+          return (n,topLevel)+      ((nf,tl),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual nf) `shouldBe` "ff"+      tl `shouldBe` False++    it "returns True if the name is defined at the top level of the module" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          let Just n = locToNameRdrPure nm (21, 1) parsed+          topLevel <- isTopLevelPN n+          return (n,topLevel)++      ((nf,tl),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual nf) `shouldBe` "DupDef.Dd1.ff"+      tl `shouldBe` True++  -- ---------------------------------------------++  describe "definedPNsRdr" $ do+    it "gets the PNs defined in a declaration" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just pn = locToNameRdrPure nm (3, 1) parsed+      (showGhcQual pn) `shouldBe` "DupDef.Dd1.toplevel"++      let origDecls = getHsDecls parsed+      let demotedDecls'= definingDeclsRdrNames nm [pn] origDecls True False+      let declaredPns = nub $ concatMap definedPNsRdr demotedDecls'++      (showGhcQual declaredPns) `shouldBe` "[toplevel]"++    -- ---------------------------------++    it "gets the PNs defined in an as-match" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just pn = locToNameRdrPure nm (14, 1) parsed+      (showGhcQual pn) `shouldBe` "DupDef.Dd1.tup"++      let origDecls = getHsDecls parsed+      let demotedDecls'= definingDeclsRdrNames nm [pn] origDecls True False+      let declaredPns = nub $ concatMap definedPNsRdr demotedDecls'++      (showGhcQual declaredPns) `shouldBe` "[tup, h, t]"+++  -- ---------------------------------------------++  describe "inScopeInfo" $ do+    it "returns 4 element tuples for in scope names" $ do+      pending -- "is this still needed?"+      {-+      ((inscopes, _renamed, _parsed), _toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let info = inScopeInfo inscopes+      (show $ head info) `shouldBe` "foo"+      -- (show $ info) `shouldBe` "foo"+      -}++  -- ---------------------------------------------++  describe "isInScopeAndUnqualified" $ do+    it "True if the identifier is in scope and unqualified" $ do+      pending -- "needed?"+      {-+      ((inscopes, _renamed, _parsed), _toks) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let info = inScopeInfo inscopes+      (show $ head info) `shouldBe` "foo"+      -}+-- inScopeInfo for c is+-- (\"DupDef.Dd1.c\",VarName,DupDef.Dd1,Nothing)++  -- ---------------------------------------------++  describe "isInScopeAndUnqualifiedGhc" $ do+    it "True if the identifier is in scope and unqualified" $ do+      let+        comp = do+         parseSourceFileGhc "./DupDef/Dd1.hs"+         ctx <- GHC.getContext+         res1 <- isInScopeAndUnqualifiedGhc "c" Nothing+         res2 <- isInScopeAndUnqualifiedGhc "DupDef.Dd1.c" Nothing+         res3 <- isInScopeAndUnqualifiedGhc "nonexistent" Nothing+         return (res1,res2,res3,ctx)+      ((r1,r2,r3,_c),_s) <- ct $ runRefactGhc comp (initialState { rsModule = Nothing }) testOptions+      r1 `shouldBe` True+      r2 `shouldBe` True+      r3 `shouldBe` False++    -- ---------------------------------++    it "requires qualification on name clash with an import" $ do+      t <- ct $ parsedFileGhc  "./ScopeAndQual.hs"+      let+        comp = do+         parseSourceFileGhc "./ScopeAndQual.hs"+         -- putParsedModule t+         renamed <- getRefactRenamed+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         logm $ "renamed=" ++ (SYB.showData SYB.Renamer 0 renamed) -- ++AZ++++         ctx <- GHC.getContext++         let Just sumSquares = locToNameRdrPure nm (13,15) parsed+         ssUnqual <- isQualifiedPN sumSquares+         names <- GHC.parseName "sum"+         names2 <- GHC.parseName "mySumSq"+         res1 <- isInScopeAndUnqualifiedGhc "sum" Nothing+         res2 <- isInScopeAndUnqualifiedGhc "L.sum" Nothing+         return (res1,res2,names,names2,sumSquares,ssUnqual,ctx)+      ((r1,r2,ns,ns2,ss,ssu,_c),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (prettyprint ss) `shouldBe` "sumSquares"+      (showGhcQual ss) `shouldBe` "ScopeAndQual.sumSquares"+      (show $ ssu) `shouldBe` "False"+      (showGhcQual ns) `shouldBe` "[ScopeAndQual.sum]"+      (showGhcQual ns2) `shouldBe` "[ScopeAndQual.mySumSq]"+      "1" ++ (show r1) `shouldBe` "1True"+      "2" ++ (show r2) `shouldBe` "2True"++  -- ---------------------------------------------++  describe "mkNewGhcName" $ do+    it "Creates a new GHC.Name" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap+         let Just topLevel = locToNameRdrPure nm (3,1) parsed++         name1 <- mkNewGhcName Nothing "foo"+         name2 <- mkNewGhcName Nothing "bar"+         name3 <- mkNewGhcName (Just (GHC.nameModule topLevel)) "baz"++         return (name1,name2,name3)+      ((n1,n2,n3),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      GHC.getOccString n1 `shouldBe` "foo"+      showGhcQual n1 `shouldBe` "foo"+      GHC.getOccString n2 `shouldBe` "bar"+      showGhcQual n2 `shouldBe` "bar"+      (showGhcQual $ GHC.nameModule n3) `shouldBe` "main@main:DupDef.Dd1"+      (SYB.showData SYB.Renamer 0 n3) `shouldBe` "{Name: baz}"+      GHC.getOccString n3 `shouldBe` "baz"+      showGhcQual n3 `shouldBe` "DupDef.Dd1.baz"+      (showGhcQual $ GHC.nameUnique n1) `shouldBe` "H2"+      (showGhcQual $ GHC.nameUnique n2) `shouldBe` "H3"+      (showGhcQual $ GHC.nameUnique n3) `shouldBe` "H4"++  -- ---------------------------------------------++  describe "prettyprint" $ do+    it "Prints a GHC.Name ready for parsing into tokens" $ do+      -- (_t, _toks, _tgt) <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         name1 <- mkNewGhcName Nothing "foo"+         name2 <- mkNewGhcName Nothing "bar"+         return (name1,name2)+      ((n1,n2),_s) <- ct $ runRefactGhcState comp+      GHC.getOccString n1 `shouldBe` "foo"+      showGhcQual n1 `shouldBe` "foo"+      GHC.getOccString n2 `shouldBe` "bar"+      showGhcQual n2 `shouldBe` "bar"+      showGhcQual n1 `shouldBe` "foo"++  -- ---------------------------------------------++  describe "duplicateDecl" $ do+    it "duplicates a bind only" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (3, 1) parsed+      let+        comp = do+         -- parsed <- getRefactParsed+         declsp <- liftT $ hsDecls parsed+         newName2 <- mkNewGhcName Nothing "bar2"+         newBindings <- duplicateDecl declsp n newName2+         parsed' <- liftT $ replaceDecls parsed newBindings+         putRefactParsed parsed' emptyAnns++         return newBindings+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "DupDef.Dd1.toplevel"+      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nbar2 :: Integer -> Integer\nbar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"++  -- ---------------------------------------------++    it "duplicates a bind with a signature, and an offset" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just np = locToNameRdrPure nm (14, 1) parsed+      (showGhcQual np) `shouldBe` "DupDef.Dd1.tup"++      let Just ln'@(GHC.L l _) = locToRdrName (17, 6) parsed+          n = rdrName2NamePure nm ln'+          ln = GHC.L l n+      (showGhcQual n) `shouldBe` "ff"+      let+        comp = do+         newName2 <- mkNewGhcName Nothing "gg"++         -- parsed <- getRefactParsed+         decls <- liftT $ hsDecls parsed++         (front,[parent],back) <- divideDecls decls ln++         (parent',Just (funBinding,declsToDup,declsp')) <- modifyValD (GHC.getLoc parent) parent $ \_m declsp -> do+           let+             declsToDup = definingDeclsRdrNames nm [n] declsp True True+             funBinding = filter isFunOrPatBindP declsToDup     --get the fun binding.++           declsp' <- duplicateDecl declsp n newName2++           return (declsp',Just (funBinding,declsToDup,declsp'))++         parsed' <- liftT $ replaceDecls parsed (front ++ [parent'] ++ back)+         putRefactParsed parsed' emptyAnns++         return (funBinding,declsToDup,declsp')++      ((fb,dd,newb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((fb,dd,newb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "ff"+      (showGhcQual dd) `shouldBe` "[ff = 15]"+      (showGhcQual fb) `shouldBe` "[ff = 15]"+      (show $ getStartEndLoc fb) `shouldBe` "((17,5),(17,12))"+      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\n    gg :: Int\n    gg = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"+      (showGhcQual newb) `shouldBe` "[ff :: Int, ff = 15, gg :: Int, gg = 15]"+      (showGhcQual fb) `shouldBe` "[ff = 15]"+++  -- ---------------------------------------------++  describe "addParamsToDecl" $ do+    it "adds parameters to a declaration" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (3, 1) parsed+      let+        comp = do+         declsp <- liftT $ hsDecls parsed+         let newName2 = mkRdrName "bar2"+         declsp' <- addParamsToDecls declsp n [newName2]+         parsed' <- liftT $ replaceDecls parsed declsp'+         putRefactParsed parsed' emptyAnns++         return declsp'+      (nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1.toplevel"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel bar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (showGhcQual $ head $ tail nb) `shouldBe` "toplevel bar2 x = c * x"++    -- ---------------------------------++    it "adds parameters to a declaration with multiple matches" $ do+      t <- ct $ parsedFileGhc "./AddParams1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (3, 1) parsed+      let+        comp = do+         declsp <- liftT $ hsDecls parsed+         let newName = mkRdrName "pow"+         declsp' <- addParamsToDecls declsp n [newName]+         parsed' <- liftT $ replaceDecls parsed declsp'+         putRefactParsed parsed' emptyAnns+         return declsp'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "AddParams1.sq"+      (sourceFromState s) `shouldBe` "module AddParams1 where\n\nsq pow  0 = 0\nsq pow  z = z^2\n\nfoo = 3\n\n"++    -- ---------------------------------++    it "adds parameters to a declaration with no existing ones" $ do+      t <- ct $ parsedFileGhc "./AddParams1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 1) parsed+      let+        comp = do+         declsp <- liftT $ hsDecls parsed+         let newName1 = mkRdrName "baz"+         let newName2 = mkRdrName "bar"+         declsp' <- addParamsToDecls declsp n [newName1,newName2]+         parsed' <- liftT $ replaceDecls parsed declsp'+         putRefactParsed parsed' emptyAnns++         return declsp'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "AddParams1.foo"+      (sourceFromState s) `shouldBe` "module AddParams1 where\n\nsq  0 = 0\nsq  z = z^2\n\nfoo baz bar = 3\n\n"++  -- ---------------------------------------------++  describe "addActualParamsToRhs" $ do+    it "adds a parameter to the rhs of a declaration" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/D1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 21) parsed+      let+        comp = do+         -- parsed <- getRefactParsed+         declsp <- liftT $ hsDecls parsed+         let decl = head declsp+         let newName2 = mkRdrName "bar2"+         newBinding <- addActualParamsToRhs n [newName2] decl++         return (newBinding,decl)+      ((nb,decl'),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,decl'),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      -- putStrLn $ "nb[]\n" ++ showAnnDataItemFromState s nb ++ "\n]"+      (showGhcQual decl') `shouldBe` "sumSquares (x : xs)\n  = sq x + sumSquares xs\n  where\n      sq x = x ^ pow\n      pow = 2\nsumSquares [] = 0"+      (showGhcQual n) `shouldBe` "sq"+      (showGhcQual nb) `shouldBe` "sumSquares (x : xs)\n  = (sq bar2) x + sumSquares xs\n  where\n      sq x = x ^ pow\n      pow = 2\nsumSquares [] = 0"+      (exactPrintFromState s nb) `shouldBe` "\n\n{-lift 'sq' to top level. This refactoring\n  affects module 'D1' and 'C1' -}\n\nsumSquares (x:xs) = (sq bar2) x + sumSquares xs\n  where\n     sq x = x ^ pow\n     pow =2\n\nsumSquares [] = 0"++    -- --------------------++    it "adds parameters to a complex rhs of a declaration" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/WhereIn7.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (10, 17) parsed+      let+        comp = do+         -- parsed <- getRefactParsed+         declsp <- liftT $ hsDecls parsed+         let decl = head declsp++         let newName1 = mkRdrName "x1"+         let newName2 = mkRdrName "y1"+         let newName3 = mkRdrName "z1"+         newBinding <- addActualParamsToRhs n [newName1,newName2,newName3] decl++         return (newBinding,decl)+      ((nb,decl'),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual decl') `shouldBe` "fun x y z\n  = inc addthree\n  where\n      inc a = a + 1\n      addthree = x + y + z"+      (showGhcQual n) `shouldBe` "addthree"+      (showGhcQual nb) `shouldBe` "fun x y z\n  = inc (addthree x1 y1 z1)\n  where\n      inc a = a + 1\n      addthree = x + y + z"+      (exactPrintFromState s nb) `shouldBe` "\n\n--A definition can be lifted from a where or let to the top level binding group.\n--Lifting a definition widens the scope of the definition.\n\n--In this example, lift 'addthree' defined in 'fun'.\n--This example aims to test adding parenthese.\n\n\nfun x y z =inc (addthree x1 y1 z1)\n       where inc a =a +1\n             addthree=x+y+z"+++  -- ---------------------------------------------++  describe "rmDecl" $ do+    it "removes a top level declaration, leaving type signature 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1a.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (6, 1) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns++         return parsed'+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1a.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1a where\n\ndata D = A | B String | C\n\nff :: Int -> Int\n\nl = 1\n\n"++    -- ---------------------------------++    it "removes a top level declaration, leaving type signature 2b" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1b.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (6, 1) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns+         return parsed'+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1b.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1b where\n\ndata D = A | C\n\nff :: Int -> Int\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\n"++    -- ---------------------------------++    it "removes a top level declaration, leaving type signature 2" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (22, 1) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns+         logDataWithAnns "parsed'" parsed'+         return parsed'+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"++    -- ---------------------------------++    it "removes a top level declaration, and type signature" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (22, 1) parsed+      let+        comp = do+         (newDecls,_removedDecl,_removedSig) <- rmDecl n True parsed+         putRefactParsed newDecls emptyAnns+         return newDecls+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"++    -- -----------------------------------++    it "removes the last local decl in a let/in clause" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/LetIn1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (11, 22) parsed+      let+        comp = do+         -- parsed <- getRefactParsed+         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed++         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "sq"+      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""+      (sourceFromState s) `shouldBe` "module LiftToToplevel.LetIn1 where\n\n--A definition can be lifted from a where or let to the top level binding group.\n--Lifting a definition widens the scope of the definition.\n\n--In this example, lift 'sq' in 'sumSquares'\n--This example aims to test lifting a definition from a let clause to top level,\n--and the elimination of the keywords 'let' and 'in'\n\nsumSquares x y = sq x + sq y\n                       where pow=2\n\nanotherFun 0 y = sq y\n     where sq x = x^2\n"++    -- -----------------------------------++    it "removes the last local decl in a where clause" $ do+      t <- ct $ parsedFileGhc "./RmDecl3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 5) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed++         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "zz"+      (sourceFromState s) `shouldBe` "module RmDecl3 where\n\n-- Remove last declaration from a where clause, where should disappear too\nff y = y + zz\n\n-- EOF\n"++    -- -----------------------------------++    it "removes the first local decl in a where clause" $ do+      t <- ct $ parsedFileGhc "./RmDecl4.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""++      let Just n = locToNameRdrPure nm (7, 5) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n True parsed++         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "zz"+      (sourceFromState s) `shouldBe` "{-# LANGUAGE FlexibleContexts #-}\nmodule RmDecl4 where\n\n-- Remove first declaration from a where clause, rest should still be indented\nff y = y + zz ++ xx\n  where\n    xx = 2\n\n-- EOF\n"++    -- -----------------------------------++    it "removes the non last local decl in a let/in clause 1" $ do+      t <- ct $ parsedFileGhc "./Demote/LetIn1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""++      let Just n = locToNameRdrPure nm (12, 22) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "pow"+      (sourceFromState s) `shouldBe` "module Demote.LetIn1 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the local  'pow' to 'sq'\n--This example also aims to test the demoting a local declaration in 'let'.\n\nsumSquares x y = let sq 0=0\n                     sq z=z^pow\n                 in sq x + sq y\n\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n  "++    -- -----------------------------------++    it "removes the non last local decl in a let/in clause 2" $ do+      t <- ct $ parsedFileGhc "./Demote/LetIn2.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (10, 22) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "sq"+      (sourceFromState s) `shouldBe` "module Demote.LetIn2 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the local  'pow' will fail.\n\nsumSquares x y = let pow=2\n                 in sq x + sq y +pow\n\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n  "++    -- -----------------------------------------------------------------++    it "removes a decl with a trailing comment" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (14, 1) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig1) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "Demote.WhereIn3.sq"+      (sourceFromState s) `shouldBe` "module Demote.WhereIn3 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where p=2  {-There is a comment-}\n\nsq :: Int -> Int -> Int\n\n{- foo bar -}\nanotherFun 0 y = sq y\n     where  sq x = x^2\n"+++    -- -----------------------------------------------------------------++    it "removes a sub decl liftOneLevel D1" $ do+      t <- ct $ parsedFileGhc "./LiftOneLevel/D1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (8, 6) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig1) <- rmDecl n False parsed+         putRefactParsed parsed' emptyAnns++         return parsed'+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "sq"+      (sourceFromState s) `shouldBe` "module LiftOneLevel.D1 where\n\n{-lift 'sq' to top level. This refactoring\naffects module 'D1' and 'C1' -}\n\nsumSquares (x:xs) = sq x + sumSquares xs\n  where\n     pow =2\n\nsumSquares [] = 0\n\nmain = sumSquares [1..4]\n"+++  -- ---------------------------------------------++  describe "rmTypeSig" $ do+    it "removes a type signature from the top level 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (22, 1) parsed+      let+        comp = do+         (renamed',sigRemoved) <- rmTypeSig n parsed+         putRefactParsed renamed' emptyAnns+         return (renamed',sigRemoved)+      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (showGhcQual os) `shouldBe` "Just ff :: Int -> Int"++    -- -----------------------------------------------------------------++    it "removes a type signature from the top level, after decl removed" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (14, 1) parsed+      let+        comp = do+         (parsed',_removedDecl,_removedSig1) <- rmDecl    n False parsed+         (parsed2,_removedSig2)              <- rmTypeSig n parsed'+         putRefactParsed parsed2 emptyAnns++         return parsed2+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "Demote.WhereIn3.sq"+      (sourceFromState s) `shouldBe` "module Demote.WhereIn3 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where p=2  {-There is a comment-}\n\n{- foo bar -}\nanotherFun 0 y = sq y\n     where  sq x = x^2\n"+++    -- -----------------------------------------------------------------++    it "removes a type signature from non-top level" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (16, 5) parsed+      let+        comp = do+         (renamed',_removedSig) <- rmTypeSig n parsed+         putRefactParsed renamed' emptyAnns+         return renamed'+      -- (_nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (_nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "ff"+      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"++    -- -----------------------------------------------------------------++    it "removes a type signature within multi signatures 1" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TypeSigs.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just b = locToNameRdrPure nm (12, 1) parsed+      let+        comp = do+         (renamed',removedSig) <- rmTypeSig b parsed+         putRefactParsed renamed' emptyAnns+         return (renamed',removedSig)+      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nb::Int->Integer->Char"+      (showGhcQual b) `shouldBe` "TypeSigs.b"+      (sourceFromState s) `shouldBe` "module TypeSigs where\n\nsq,anotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^2\n\nanotherFun x = x^2\n\na,c::Int->Integer->Char\n\na x y = undefined\nb x y = undefined\nc x y = undefined\n\n"++    -- -----------------------------------------------------------------++    it "removes a type signature within multi signatures 2" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/TypeSigs.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (4, 1) parsed+      let+        comp = do+         (renamed',removedSig) <- rmTypeSig n parsed+         putRefactParsed renamed' emptyAnns+         return (renamed',removedSig)+      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- putStrLn $ "anntree\n" ++ showAnnDataFromState s+      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nsq :: Int -> Int"+      (showGhcQual n) `shouldBe` "TypeSigs.sq"+      (sourceFromState s) `shouldBe` "module TypeSigs where\n\nanotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^2\n\nanotherFun x = x^2\n\na,b,c::Int->Integer->Char\n\na x y = undefined\nb x y = undefined\nc x y = undefined\n\n"+      (showGhcQual os) `shouldBe` "Just sq :: Int -> Int"++    -- -----------------------------------------------------------------++    it "removes a type signature within multi signatures 3" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn7.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (12, 1) parsed+      let+        comp = do+         (parsed',removedSig) <- rmTypeSig n parsed+         putRefactParsed parsed' emptyAnns+         return (parsed',removedSig)+      -- ((_nb,os),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((_nb,os),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "WhereIn7.sq"+      (exactPrintFromState s (fromJust os)) `shouldBe` "\n\nsq :: Int -> Int"+      (sourceFromState s) `shouldBe` "module WhereIn7 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--This example also aims to test the split of type signature.\n\nsumSquares x y = sq x + sq y\n\nanotherFun :: Int -> Int\nsq 0 = 0\nsq z = z^pow\n   where  pow=2\n\nanotherFun x = x^2\n "+      (showGhcQual os) `shouldBe` "Just sq :: Int -> Int"++    -- -----------------------------------------------------------------+{-+    it "removes a type signature for a pattern in a bind" $ do+      t <- ct $ parsedFileGhc "./LiftToToplevel/PatBindIn1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let Just (GHC.L _ n) = locToName (GHC.mkFastString "./test/testdata/LiftToToplevel/PatBindIn1.hs") (18, 7) renamed+      let+        comp = do+         (renamed',removedSig) <- rmTypeSig n renamed+         let (Just (GHC.L ss _)) = removedSig+         oldSigToks <- getToksForSpan ss+         return (renamed',removedSig,oldSigToks)+      -- ((nb,os,ot),s) <- runRefactGhc comp $ initialState { rsModule = initRefactModule [] t }+      ((nb,os,ot),s) <- runRefactGhc comp $ initialLogOnState { rsModule = initRefactModule [] t }+      (showGhcQual n) `shouldBe` "tup"+      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""+      (sourceFromState s) `shouldBe` "module LiftToToplevel.PatBindIn1 where\n\n --A definition can be lifted from a where or let into the surrounding binding group.\n --Lifting a definition widens the scope of the definition.\n\n --In this example, lift 'tup' defined in 'foo'\n --This example aims to test renaming and the lifting of type signatures.\n\n main :: Int\n main = foo 3\n\n foo :: Int -> Int\n foo x = h + t + (snd tup)\n       where\n       \n       \n\n       tup@(h,t) = head $ zip [1..10] [3..15]\n "+      (showGhcQual nb) `shouldBe` ""+      (showGhcQual os) `shouldBe` ""+      (GHC.showRichTokenStream ot) `shouldBe` ""+-}+  -- ---------------------------------------------++  describe "addDecl" $ do+    it "adds a top level declaration without a type signature, in default pos" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "a" "nn = n2")+         -- let declAnns' = setPrecedingLines declAnns newDecl 2+         parsed' <- addDecl parsed Nothing ([decl],Just declAnns)+         putRefactParsed parsed' emptyAnns+         return parsed'+      (nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (nb,s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\nnn = n2\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\nnn = n2\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"++    -- -------------------------------------------++    it "adds a top level declaration with a type signature 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = 2")+         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")+         parsed' <- addDecl parsed Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)+         putRefactParsed parsed' emptyAnns+         return (sig,parsed')+      ((_hs,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\nnn :: Int\nnn = 2\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\nnn :: Int\nnn = 2\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"++    -- -------------------------------------------++    it "adds a top level declaration after a specified one 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "a" "nn = nn2")+         nm <- getRefactNameMap+         let Just n = locToNameRdrPure nm (21, 1) parsed+         parsed' <- addDecl parsed (Just n) ([decl],Just declAnns)+         putRefactParsed parsed' emptyAnns+         return (n,parsed')+      ((n,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((n,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "MoveDef.Md1.ff"+      (sourceFromState s) `shouldBe` "module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nnn = nn2\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nnn = nn2\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"+++    -- -------------------------------------------++    it "adds a top level declaration after a specified one 2" $ do+      t <- ct $ parsedFileGhc "./AddOneParameter/FunIn1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "a" "nn = nn2")+         nm <- getRefactNameMap+         let Just n = locToNameRdrPure nm (7, 1) parsed+         parsed' <- addDecl parsed (Just n) ([decl],Just declAnns)+         putRefactParsed parsed' emptyAnns+         return (n,parsed')+      ((n,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((n,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "FunIn1.foo"+      -- putStrLn (sourceFromState s)+      (sourceFromState s) `shouldBe` "module FunIn1 where\n\n--Default parameters can be added to definition of functions and simple constants.\n\n--In this example: add parameter 'y' to 'foo'\nfoo :: Int -> Int\nfoo  x= h + t where (h,t) = head $ zip [1..x] [3..15] {-There\nis a comment-}\n\nnn = nn2\n\nmain :: Int\nmain = foo 4\n"+      (unspace $ showGhcQual nb) `shouldBe` unspace "module FunIn1 where\nfoo :: Int -> Int\nfoo x\n = h + t\n where\n (h, t) = head $ zip [1 .. x] [3 .. 15]\nnn = nn2\nmain :: Int\nmain = foo 4"+++    -- -------------------------------------------++    it "adds a top level declaration with a type signature after a specified one" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap+         let Just n = locToNameRdrPure nm (21, 1) parsed+         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")+         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")+         parsed' <- addDecl parsed (Just n) ([sig,decl],Just $ mergeAnns sigAnns declAnns)+         putRefactParsed parsed' emptyAnns+         return (n,parsed')+      ((nn,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual nn) `shouldBe` "MoveDef.Md1.ff"+      (sourceFromState s) `shouldBe`"module MoveDef.Md1 where\n\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff :: Int -> Int\nff y = y + zz\n  where\n    zz = 1\n\nnn :: Int\nnn = nn2\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\nzz1 a = 1 + toplevel a\n\n-- General Comment\n-- |haddock comment\ntlFunc :: Integer -> Integer\ntlFunc x = c * x\n-- Comment at end\n\n\n"+      (unspace $ showGhcQual nb) `shouldBe` unspace "module MoveDef.Md1 where\ntoplevel :: Integer -> Integer\ntoplevel x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n = head $ zip [1 .. 10] [3 .. ff]\n where\n ff :: Int\n ff = 15\ndata D = A | B String | C\nff :: Int -> Int\nff y\n = y + zz\n where\n zz = 1\nnn :: Int\nnn = nn2\nl z = let ll = 34 in ll + z\ndd q\n = do { let ss = 5;\n return (ss + q) }\nzz1 a = 1 + toplevel a\ntlFunc :: Integer -> Integer\ntlFunc x = c * x"+++    -- -------------------------------------------++    it "adds a local declaration without a type signature 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"++      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (4, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")++         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)++         logm $ "test:addDecl done"++         return (tlDecl,newDecl)+      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "toplevel x = c * x"+      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn = nn2"+      (showGhcQual nb)           `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2"++    -- -------------------------------------------++    it "adds a local declaration with a type signature 1" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (4, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")+         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")++         newDecl <- addDecl tlDecl Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)++         return (tlDecl,newDecl)+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "toplevel x = c * x"+      -- putStrLn (showAnnDataItemFromState s nb)+      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn :: Int\n    nn = nn2"+      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2\n      nn :: Int"+    -- -------------------------------------------++    it "adds a local declaration with a where clause" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Demote.hs"+      let+        comp = do++         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (4, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")++         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)++         return (tlDecl,newDecl)+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "toplevel x = c * x"+      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x\n  where\n    nn = nn2"+      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x\n  where\n      nn = nn2"++    -- -------------------------------------------++    it "adds a local declaration to an existing one" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md2.hs"+      let+        comp = do++         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (4, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")++         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)++         return (tlDecl,newDecl)+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3"+      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x * b\n  where\n    nn = nn2\n\n    b = 3"+      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3\n      nn = nn2"++    -- -------------------------------------------++    it "adds a local declaration with a type signature to an existing one" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Md2.hs"+      let+        comp = do++         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (4, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")+         (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")++         newDecl <- addDecl tlDecl Nothing ([sig,decl],Just $ mergeAnns sigAnns declAnns)++         return (tlDecl,newDecl)+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3"+      (exactPrintFromState s nb) `shouldBe` "\ntoplevel x = c * x * b\n  where\n    nn :: Int\n    nn = nn2\n\n    b = 3"+      (showGhcQual nb) `shouldBe` "toplevel x\n  = c * x * b\n  where\n      b = 3\n      nn = nn2\n      nn :: Int"++    -- -------------------------------------------++    it "adds a local decl with type signature to an existing one, with a comment" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn3.hs"+      let+        comp = do+         parsed  <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (10, 1) parsed+         decls <- liftT (hsDecls parsed)+         let [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         let Just sq = locToNameRdrPure nm (14, 1) parsed+         let Just af = locToNameRdrPure nm (18, 1) parsed++         let [sqSig]  = definingSigsRdrNames  nm [sq] parsed+             [sqDecl] = definingDeclsRdrNames nm [sq] decls False False+             [afDecl] = definingDeclsRdrNames nm [af] decls False False++         let  sqSigDecl = wrapSig sqSig+         liftT (balanceComments tlDecl sqSigDecl)+         liftT (balanceComments sqDecl afDecl)++         newDecl <- addDecl tlDecl Nothing ([sqSigDecl,sqDecl],Nothing)++         return (sqSig,sqDecl,tlDecl,afDecl,newDecl)+      -- ((sigs,_sd,tl,aa,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((sigs,_sd,tl,aa,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual sigs) `shouldBe` "sq :: Int -> Int -> Int"+      (showGhcQual tl) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"+      (showGhcQual aa) `shouldBe` "anotherFun 0 y\n  = sq y\n  where\n      sq x = x ^ 2"+      (exactPrintFromState s nb) `shouldBe` "\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there are multi matches), the parameters are not folded after demoting.\n\nsumSquares x y = sq p x + sq p y\n         where sq :: Int -> Int -> Int\n               sq pow 0 = 0\n               sq pow z = z^pow  --there is a comment\n\n               p=2  {-There is a comment-}"+      (showGhcQual nb) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2\n      sq :: Int -> Int -> Int\n      sq pow 0 = 0\n      sq pow z = z ^ pow"++    -- -------------------------------------------++    it "does not add a local decl to a FunBind with multiple matches" $ do+      t <- ct $ parsedFileGhc "./MoveDef/MultiFunBind1.hs"+      let+        comp = do+         parsed  <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (3, 1) parsed+         decls <- liftT (hsDecls parsed)+         let -- decls = hsBinds parsed+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         let Just y = locToNameRdrPure nm (6, 1) parsed++         let [yDecl] = definingDeclsRdrNames nm [y] decls False False++         newDecl <- addDecl tlDecl Nothing ([yDecl],Nothing)++         return (yDecl,tlDecl,newDecl)+      Just r <- catchException $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (isPrefixOf "addDecl:Cannot add a local decl to a FunBind with multiple matches" r) `shouldBe` True++    -- -------------------------------------------++    it "adds a local declaration to a PatBind" $ do+      t <- ct $ parsedFileGhc "./MoveDef/PatBind1.hs"+      let+        comp = do++         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let Just tl = locToNameRdrPure nm (3, 1) parsed+         decls <- liftT (hsDecls parsed)+         let+             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False++         (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")++         newDecl <- addDecl tlDecl Nothing ([decl],Just declAnns)++         return (tlDecl,newDecl)+      ((tl,nb),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((tl,nb),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual tl) `shouldBe` "tup@(h, t) = (x, 1)"+      (exactPrintFromState s nb) `shouldBe` "\n\ntup@(h,t) = (x,1)\n  where\n    nn = nn2"+      (showGhcQual nb) `shouldBe` "tup@(h, t)\n  = (x, 1)\n  where\n      nn = nn2"++  -- ---------------------------------------------++  describe "renamePN" $ do+    it "replaces a Name with another 1" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap+         let Just n' = locToNameRdrPure nm (3, 1) parsed+         newName <- mkNewGhcName Nothing "bar2"+         new <- renamePN n' newName PreserveQualify parsed+         putRefactParsed new emptyAnns+         return (new,newName,n')+      let++      ((nb,nn,n),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual (n,nn)) `shouldBe` "(DupDef.Dd1.toplevel, bar2)"+      (sourceFromState s) `shouldBe` "module DupDef.Dd1 where\n\nbar2 :: Integer -> Integer\nbar2 x = c * x\n\nc,d :: Integer\nc = 7\nd = 9\n\n-- Pattern bind\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h,t) = head $ zip [1..10] [3..ff]\n  where\n    ff :: Int\n    ff = 15\n\ndata D = A | B String | C\n\nff y = y + zz\n  where\n    zz = 1\n\nl z =\n  let\n    ll = 34\n  in ll + z\n\ndd q = do\n  let ss = 5\n  return (ss + q)\n\n"+      (showGhcQual nb) `shouldBe` "module DupDef.Dd1 where\nbar2 :: Integer -> Integer\nbar2 x = c * x\nc, d :: Integer\nc = 7\nd = 9\ntup :: (Int, Int)\nh :: Int\nt :: Int\ntup@(h, t)\n  = head $ zip [1 .. 10] [3 .. ff]\n  where\n      ff :: Int\n      ff = 15\ndata D = A | B String | C\nff y\n  = y + zz\n  where\n      zz = 1\nl z = let ll = 34 in ll + z\ndd q\n  = do { let ss = 5;\n         return (ss + q) }"++    -- -----------------------------------------------------------------++    it "replaces a Name with another 2" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn4.hs"++      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap+         declsr <- liftT $ hsDecls parsed+         let decl = head $ drop 0 declsr+         let Just n' = locToNameRdrPure nm (11, 21) parsed+         newName <- mkNewGhcName Nothing "p_1"+         new <- renamePN n' newName PreserveQualify decl+         parsed' <- liftT $ replaceDecls parsed (new:tail declsr)+         putRefactParsed parsed' emptyAnns+         return (new,newName,decl,n')+      let+      ((nb,nn,d,n),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual d) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"+      (showGhcQual (n,nn)) `shouldBe` "(p, p_1)"+      (sourceFromState s) `shouldBe` "module Demote.WhereIn4 where\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there is single matches), if possible,\n--the parameters will be folded after demoting and type sigature will be removed.\n\nsumSquares x y = sq p_1 x + sq p_1 y\n         where p_1=2  {-There is a comment-}\n\nsq::Int->Int->Int\nsq pow z = z^pow  --there is a comment\n\nanotherFun 0 y = sq y\n     where  sq x = x^2\n\n"+      (showGhcQual nb) `shouldBe` "sumSquares x y\n  = sq p_1 x + sq p_1 y\n  where\n      p_1 = 2"+++    -- ---------------------------------++    it "replaces a Name with another in limited scope 1" $ do+      t <- ct $ parsedFileGhc "./TokenTest.hs"++      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (19, 1) parsed+      (showGhcQual n) `shouldBe` "TokenTest.foo"++      let+        comp = do+         -- parsed <- getRefactParsed+         decls <- liftT $ hsDecls parsed+         newName <- mkNewGhcName Nothing "bar2"+         new <- renamePN n newName PreserveQualify (head $ drop 3 decls)+         parsed' <- liftT $ replaceDecls parsed (take 3 decls ++ [new] ++ drop 4 decls)+         putRefactParsed parsed' emptyAnns+         return (new,newName)+      let++      ((nb,nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual (n,nn)) `shouldBe` "(TokenTest.foo, bar2)"+      (sourceFromState s) `shouldBe` "module TokenTest where\n\n-- Test new style token manager\n\nbob a b = x\n  where x = 3\n\nbib a b = x\n  where\n    x = 3\n\n\nbab a b =\n  let bar = 3\n  in     b + bar -- ^trailing comment\n\n\n-- leading comment\nbar2 x y =\n  do c <- getChar\n     return c\n\n\n\n\n"+      (showGhcQual nb) `shouldBe` "bar2 x y\n  = do { c <- getChar;\n         return c }"+      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""++    -- ---------------------------------++    it "replace a Name with another in limited scope 2" $ do+      t <- ct $ parsedFileGhc "./TokenTest.hs"++      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+      let Just n = locToNameRdrPure nm (19, 1) parsed+      (showGhcQual n) `shouldBe` "TokenTest.foo"++      let+        comp = do+         -- parsed <- getRefactParsed+         decls <- liftT $ hsDecls parsed+         let decl = head $ drop 3 decls+         newName <- mkNewGhcName Nothing "bar2"+         new <- renamePN n newName PreserveQualify decl++         parsed' <- liftT $ replaceDecls parsed (take 3 decls ++ [new] ++ drop 4 decls)+         putRefactParsed parsed' emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "TokenTest.foo"+      (sourceFromState s) `shouldBe` "module TokenTest where\n\n-- Test new style token manager\n\nbob a b = x\n  where x = 3\n\nbib a b = x\n  where\n    x = 3\n\n\nbab a b =\n  let bar = 3\n  in     b + bar -- ^trailing comment\n\n\n-- leading comment\nbar2 x y =\n  do c <- getChar\n     return c\n\n\n\n\n"+      (showGhcQual nb) `shouldBe` "bar2 x y\n  = do { c <- getChar;\n         return c }"+      -- (showToks $ take 20 $ toksFromState s) `shouldBe` ""++    ------------------------------------++    it "replaces a name in a data declaration too" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (5, 19) parsed+      let+        comp = do+         logParsedSource "parsed"+         logm $ "nm:" ++ showNameMap nm+         logm $ "n:nameUnique:" ++ show (GHC.nameUnique n)+         newName <- mkNewGhcName Nothing "pointx1"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logParsedSource "parsed:after"+         return (new,newName)+      let++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "Field1.pointx"+      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata Point = Pt {pointx1, pointy :: Float}\n\nabsPoint :: Point -> Float\nabsPoint p = sqrt (pointx1 p * pointx1 p +\n                  pointy p * pointy p)\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module Field1 where\ndata Point = Pt {pointx1, pointy :: Float}\nabsPoint :: Point -> Float\nabsPoint p = sqrt (pointx1 p * pointx1 p + pointy p * pointy p)"+++    ------------------------------------++    it "replaces a name in a type signature too" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (5, 6) parsed+      let+        comp = do+         logParsedSource "parsed"+         newName <- mkNewGhcName Nothing "NewPoint"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logParsedSource "parsed:after"++         return (new,newName)+      let++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "Field1.Point"+      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata NewPoint = Pt {pointx, pointy :: Float}\n\nabsPoint :: NewPoint -> Float\nabsPoint p = sqrt (pointx p * pointx p +\n                  pointy p * pointy p)\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module Field1 where\ndata NewPoint = Pt {pointx, pointy :: Float}\nabsPoint :: NewPoint -> Float\nabsPoint p = sqrt (pointx p * pointx p + pointy p * pointy p)"++    ------------------------------------++    it "replace a name in a FunBind with multiple patterns" $ do+      t <- ct $ parsedFileGhc "./LocToName.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (20, 1) parsed+      let+        comp = do+         newName <- mkNewGhcName Nothing "newPoint"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)+      let++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "LocToName.sumSquares"+      (sourceFromState s) `shouldBe` "module LocToName where\n\n{-\n\n\n\n\n\n\n\n\n-}\n\n\n\n\n\n\n\nnewPoint (x:xs) = x ^2 + newPoint xs\n    -- where sq x = x ^pow \n    --       pow = 2\n\nnewPoint [] = 0\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LocToName where\nnewPoint (x : xs) = x ^ 2 + newPoint xs\nnewPoint [] = 0"++    ------------------------------------++    it "replaces a qualified name in a FunBind with multiple patterns" $ do+      t <- ct $ parsedFileGhc "./LocToName.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+#if __GLASGOW_HASKELL__ <= 710+      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")+#else+      let modu = GHC.mkModule (GHC.stringToUnitId     "mypackage-1.0") (GHC.mkModuleName "LocToName")+#endif++      let Just n = locToNameRdrPure nm (20, 1) parsed+      let+        comp = do+         -- logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)+         logDataWithAnns "parsed" parsed+         newName <- mkNewGhcName (Just modu) "newPoint"+         new <- renamePN n newName Qualify parsed++         putRefactParsed new emptyAnns+         -- logParsedSource "parsed:after"++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n) `shouldBe` "LocToName.sumSquares"+      (unspace $ showGhcQual nb) `shouldBe` "module LocToName where\nLocToName.newPoint (x : xs) = x ^ 2 + LocToName.newPoint xs\nLocToName.newPoint [] = 0"+      (sourceFromState s) `shouldBe` "module LocToName where\n\n{-\n\n\n\n\n\n\n\n\n-}\n\n\n\n\n\n\n\nnewPoint (x:xs) = x ^2 + LocToName.newPoint xs\n    -- where sq x = x ^pow \n    --       pow = 2\n\nnewPoint [] = 0\n"+++    ------------------------------------++    it "replaces a parameter name in a FunBind" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (8, 7) parsed+      let+        comp = do+         logParsedSource "parsed"++         newName <- mkNewGhcName Nothing "ls"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logParsedSource "parsed:after"++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly ls = case ls of  (1:xs) -> 1\n--There is a comment\n                       (2:xs)\n                         | x < 10    -> 4  where  x = last xs\n                       otherwise -> 12\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly ls\n = case ls of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"+++    ------------------------------------++    it "does not qualify a name in an import hiding clause" $ do+      t <- ct $ parsedFileGhc "./ScopeAndQual.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+#if __GLASGOW_HASKELL__ <= 710+      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")+#else+      let modu = GHC.mkModule (GHC.stringToUnitId "mypackage-1.0") (GHC.mkModuleName "LocToName")+#endif++      let Just n = locToNameRdrPure nm (4, 24) parsed+      let+        comp = do+         logParsedSource "parsed"+         newName <- mkNewGhcName (Just modu) "mySum"+         new <- renamePN n newName Qualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "Data.Foldable.sum"+      (sourceFromState s) `shouldBe` "module ScopeAndQual where\n\nimport qualified Data.List as L\nimport Prelude hiding (mySum)\n\nmain :: IO ()\nmain = putStrLn (show $ L.mySum [1,2,3])\n\nsum a b = a + b\n\nsumSquares xs = L.mySum $ map (\\x -> x*x) xs\n\nmySumSq = sumSquares\n"+      (unspace $ showGhcQual nb) `shouldBe` "module ScopeAndQual where\nimport qualified Data.List as L\nimport Prelude hiding ( mySum )\nmain :: IO ()\nmain = putStrLn (show $ L.mySum [1, 2, 3])\nsum a b = a + b\nsumSquares xs = L.mySum $ map (\\ x -> x * x) xs\nmySumSq = sumSquares"+++    ------------------------------------++    it "does not qualify the subject of a type signature" $ do+      t <- ct $ parsedFileGhc "./Renaming/C7.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t+#if __GLASGOW_HASKELL__ <= 710+      let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")+#else+      let modu = GHC.mkModule (GHC.stringToUnitId "mypackage-1.0") (GHC.mkModuleName "LocToName")+#endif++      let Just n = locToNameRdrPure nm (5, 1) parsed+      let+        comp = do+         logParsedSource "parsed"+         newName <- mkNewGhcName (Just modu) "myNewFringe"++         new <- renamePN n newName Qualify parsed+         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "Renaming.C7.myFringe"+      (sourceFromState s) `shouldBe` "module Renaming.C7(LocToName.myNewFringe)  where\n\nimport Renaming.D7\n\nmyNewFringe:: Tree a -> [a]\nmyNewFringe (Leaf x ) = [x]\nmyNewFringe (Branch left right) = LocToName.myNewFringe left ++ fringe right\n\n\n\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module Renaming.C7 (\n LocToName.myNewFringe\n ) where\nimport Renaming.D7\nmyNewFringe :: Tree a -> [a]\nLocToName.myNewFringe (Leaf x) = [x]\nLocToName.myNewFringe (Branch left right)\n = LocToName.myNewFringe left ++ fringe right"++    ------------------------------------++    it "realigns in a case for a shorter name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (8, 7) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "ls"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "list"+      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly ls = case ls of  (1:xs) -> 1\n--There is a comment\n                       (2:xs)\n                         | x < 10    -> 4  where  x = last xs\n                       otherwise -> 12\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly ls\n = case ls of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"++++    ------------------------------------++    it "realigns in a case for a longer name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn2.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (8, 7) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "listlonger"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "list"+      (sourceFromState s) `shouldBe` "module LayoutIn2 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'list' to 'ls'.\n\nsilly :: [Int] -> Int\nsilly listlonger = case listlonger of  (1:xs) -> 1\n            --There is a comment\n                                       (2:xs)\n                                         | x < 10    -> 4  where  x = last xs\n                                       otherwise -> 12\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn2 where\nsilly :: [Int] -> Int\nsilly listlonger\n = case listlonger of {\n (1 : xs) -> 1\n (2 : xs)\n | x < 10 -> 4\n where\n x = last xs\n otherwise -> 12 }"+++    ------------------------------------++    it "realigns in a do for a shorter name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn4.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 8) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "io"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "ioFun"+      (sourceFromState s) `shouldBe` "module LayoutIn4 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'ioFun' to  'io'\n\nmain = io \"hello\" where io s= do  let  k = reverse s\n--There is a comment\n                                  s <- getLine\n                                  let  q = (k ++ s)\n                                  putStr q\n                                  putStr \"foo\"\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn4 where\nmain\n = io \"hello\"\n where\n io s\n = do { let k = reverse s;\n s <- getLine;\n let q = (k ++ s);\n putStr q;\n putStr \"foo\" }"+++    ------------------------------------++    it "realigns in a do for a longer name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn4.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 8) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "ioFunLong"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "ioFun"+      (sourceFromState s) `shouldBe` "module LayoutIn4 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'ioFun' to  'io'\n\nmain = ioFunLong \"hello\" where ioFunLong s= do  let  k = reverse s\n         --There is a comment\n                                                s <- getLine\n                                                let  q = (k ++ s)\n                                                putStr q\n                                                putStr \"foo\"\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn4 where\nmain\n = ioFunLong \"hello\"\n where\n ioFunLong s\n = do { let k = reverse s;\n s <- getLine;\n let q = (k ++ s);\n putStr q;\n putStr \"foo\" }"++    ------------------------------------++    it "realigns in a where for a shorter name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 17) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "q"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "sq"+      (sourceFromState s) `shouldBe` "module LayoutIn1 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'sq' to 'square'.\n\nsumSquares x y= q x + q y where q x= x^pow\n--There is a comment.\n                                pow=2\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn1 where\nsumSquares x y\n = q x + q y\n where\n q x = x ^ pow\n pow = 2"+++    ------------------------------------++    it "realigns in a where for a longer name" $ do+      t <- ct $ parsedFileGhc "./Renaming/LayoutIn1.hs"+      -- let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 17) parsed+      let+        comp = do+         -- logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)+         logParsedSource "parsed"++         newName <- mkNewGhcName Nothing "square"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,_nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "sq"+      (sourceFromState s) `shouldBe` "module LayoutIn1 where\n\n--Layout rule applies after 'where','let','do' and 'of'\n\n--In this Example: rename 'sq' to 'square'.\n\nsumSquares x y= square x + square y where square x= x^pow\n          --There is a comment.\n                                          pow=2\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutIn1 where\nsumSquares x y\n = square x + square y\n where\n square x = x ^ pow\n pow = 2"++    ------------------------------------++    it "realigns in a let/in for a shorter name" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 6) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "x"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "xxx"+      (sourceFromState s) `shouldBe` "module LayoutLet1 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n\nfoo x = let a = 1\n            b = 2\n        in x + a + b\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet1 where\nfoo x\n = let\n a = 1\n b = 2\n in x + a + b"++    ------------------------------------++    it "realigns in a let/in for a longer name 1" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet1.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 6) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "xxxlong"+         -- new <- renamePN n newName False renamed+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,_nn),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,nn),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "xxx"+      (sourceFromState s) `shouldBe` "module LayoutLet1 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n\nfoo xxxlong = let a = 1\n                  b = 2\n              in xxxlong + a + b\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet1 where\nfoo xxxlong\n = let\n a = 1\n b = 2\n in xxxlong + a + b"+++    ------------------------------------++    it "realigns in a let/in for a longer name 2" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/LayoutLet2.hs"+      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 6) parsed+      let+        comp = do+         logm $ "renamed:" ++ (SYB.showData SYB.Renamer 0 renamed)++         newName <- mkNewGhcName Nothing "xxxlong"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns++         return (new,newName)++      ((nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (n,nn)) `shouldBe` "(xxx, xxxlong)"+      (sourceFromState s) `shouldBe` "module LayoutLet2 where\n\n-- Simple let expression, rename xxx to something longer or shorter\n-- and the let/in layout should adjust accordingly\n-- In this case the tokens for xxx + a + b should also shift out\n\nfoo xxxlong = let a = 1\n                  b = 2 in xxxlong + a + b\n\n"+      (unspace $ showGhcQual nb) `shouldBe` "module LayoutLet2 where\nfoo xxxlong\n = let\n a = 1\n b = 2\n in xxxlong + a + b"+++    ------------------------------------++    it "renames an exported data type" $ do+      t <- ct $ parsedFileGhc "./Renaming/RenameInExportedType2.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (6, 24) parsed+      let+        comp = do+         logm $ "parsed:" ++ (SYB.showData SYB.Parser 0 parsed)++         newName <- mkNewGhcName Nothing "NewType"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logm $ "parsed:after" ++ (SYB.showData SYB.Parser 0 new)++         return (new,newName)++      ((_nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((_nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (n,nn)) `shouldBe` "(Renaming.RenameInExportedType.NT, NewType)"+      (sourceFromState s) `shouldBe` "module Renaming.RenameInExportedType\n  (\n  MyType (NewType)\n  ) where\n\ndata MyType = MT Int | NewType\n\n\n"++    ------------------------------------++    it "renames a qualified usage of a name" $ do+      t <- ct $ parsedFileGhc "./Renaming/QualClient.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (10, 10) parsed+      let+        comp = do+         logm $ "parsed:" ++ (SYB.showData SYB.Parser 0 parsed)++         newName <- mkNewGhcName Nothing "foo1"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logm $ "parsed:after" ++ (SYB.showData SYB.Parser 0 new)++         return (new,newName)++      ((_nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((_nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (n,nn)) `shouldBe` "(Renaming.QualServer.foo, foo1)"+      (sourceFromState s) `shouldBe` "module Renaming.QualClient where\n\n{- foo is imported qualified as in QualClient. Renaming should\n   preserve the qualification there\n-}\n\nimport qualified Renaming.QualServer as QS\n\nbaz :: String\nbaz = QS.foo1 : \"hello\"\n"++    ------------------------------------++    it "renames a class op signature" $ do+      t <- ct $ parsedFileGhc "./Renaming/D4.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (13, 5) parsed+      let+        comp = do+         logm $ "parsed:" ++ (SYB.showData SYB.Parser 0 parsed)++         newName <- mkNewGhcName Nothing "isSameOrNot"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logm $ "parsed:after" ++ (SYB.showData SYB.Parser 0 new)++         return (new,newName)++      ((_nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((_nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (n,nn)) `shouldBe` "(Renaming.D4.isSame, isSameOrNot)"+      (sourceFromState s) `shouldBe` "module Renaming.D4 where\n\n{-Rename instance name 'isSame'' to 'sameOrNot'.\n  This refactoring affects module `D4', 'B4' and 'C4' -}\n\ndata Tree a = Leaf a | Branch (Tree a) (Tree a)\n\nfringe :: Tree a -> [a]\nfringe (Leaf x ) = [x]\nfringe (Branch left right) = fringe left ++ fringe right\n\nclass SameOrNot a where\n   isSameOrNot  :: a -> a -> Bool\n   isNotSame :: a -> a -> Bool\n\ninstance SameOrNot Int where\n   isSameOrNot a  b = a == b\n   isNotSame a b = a /= b\n\nsumSquares (x:xs) = sq x + sumSquares xs\n    where sq x = x ^pow\n          pow = 2\n\nsumSquares [] = 0\n"+++    ------------------------------------++    it "renames a data decl parameter" $ do+      t <- ct $ parsedFileGhc "./Renaming/ConstructorIn3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (9, 13) parsed+      let+        comp = do+         logParsedSource "parsed"++         newName <- mkNewGhcName Nothing "b"+         new <- renamePN n newName PreserveQualify parsed++         putRefactParsed new emptyAnns+         logParsedSource "parsed:after"++         return (new,newName)++      ((_nb,nn),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((_nb,nn),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (n,nn)) `shouldBe` "(a, b)"+      (sourceFromState s) `shouldBe` "module ConstructorIn3 where\n\n\n--Any type/data constructor name declared in this module can be renamed.\n--Any type variable can be renamed.\n\n--Rename tyoe variable 'a' in BTree to 'b'\n\ndata BTree b = Empty | T b (BTree b) (BTree b)\n               deriving Show\n\nbuildtree :: Ord a => [a] -> BTree a\nbuildtree [] = Empty\nbuildtree (x:xs) = insert x (buildtree xs)\n\ninsert :: Ord a => a -> BTree a -> BTree a\ninsert val Empty = T val Empty Empty\ninsert val tree@(T tval left right)\n   | val > tval = T tval left (insert val right)\n   | otherwise = T tval (insert val left) right\n\nmain :: BTree Int\nmain = buildtree [3,1,2]\n"+++  -- ---------------------------------------------++  describe "qualifyToplevelName" $ do+    it "qualifies a name at the top level" $ do+      t <- ct $ parsedFileGhc "./Renaming/C7.hs"+      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t+          nm      = initRdrNameMap t++      let Just n = locToNameRdrPure nm (7, 1) parsed+      let+        comp = do+         qualifyToplevelName n++         return ()+      let++      (_,s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- (_,s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "Renaming.C7.myFringe"+      (sourceFromState s) `shouldBe` "module Renaming.C7(Renaming.C7.myFringe)  where\n\nimport Renaming.D7\n\nmyFringe:: Tree a -> [a]\nmyFringe (Leaf x ) = [x]\nmyFringe (Branch left right) = Renaming.C7.myFringe left ++ fringe right\n\n\n\n\n"++++  -- ---------------------------------------------++  describe "findEntity" $ do+    it "returns true if a (Located) Name is part of a HsBind 1" $ do+      pendingWith "this may go away"+      {-+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         parentr <- getRefactRenamed+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let (Just ln'@(GHC.L l _)) = locToRdrName (4,1) parsed+         let n = rdrName2NamePure nm ln'+             ln = GHC.L l n++         let declsr = hsBinds parentr+             duplicatedDecls = definingDeclsNames [n] declsr True False++             res  = findEntity ln duplicatedDecls+             res2 = findEntity n duplicatedDecls+             -- res = findEntity' ln duplicatedDecls++         return (res,res2,duplicatedDecls,ln)+      ((r,r2,d,_l),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual d) `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"+      (showGhcQual _l) `shouldBe` "DupDef.Dd1.toplevel"+      ("1" ++ show r) `shouldBe` "1True"+      ("2" ++ show r2) `shouldBe` "2True"+      -}++    -- ---------------------------------++    it "returns true if a (Located) Name is part of a HsBind 2" $ do+      pendingWith "this may go away"+      {-+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         parentr <- getRefactRenamed+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let (Just ln'@(GHC.L l _)) = locToRdrName (31,7) parsed+         let n = rdrName2NamePure nm ln'+             ln = GHC.L l n++         let (Just nd) = locToNameRdrPure nm (30,1) parsed++         let declsr = hsBinds parentr+             duplicatedDecls = definingDeclsNames [nd] declsr True False++             res = findEntity ln duplicatedDecls+             res2 = findEntity  n duplicatedDecls++         return (res,res2,duplicatedDecls,ln)+      ((r,r2,d,_l),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual d) `shouldBe` "[DupDef.Dd1.dd q\n   = do { let ss = 5;\n"+++                             "          GHC.Base.return (ss GHC.Num.+ q) }]"+      (showGhcQual _l) `shouldBe` "ss"+      ("1" ++ show r) `shouldBe` "1True"+      ("2" ++ show r2) `shouldBe` "2True"+      -}++    -- -----------------------------------------------------------------++    it "returns false if a syntax phrase is not part of another" $ do+      pendingWith "this may go away"+      {-+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         parentr <- getRefactRenamed+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let (Just n) = locToNameRdrPure nm (4,1) parsed++         let (Just tup) = locToNameRdrPure nm (11,1) parsed++         let declsr = hsBinds parentr+             duplicatedDecls = definingDeclsNames [n] declsr True False++             res = findEntity tup duplicatedDecls+             -- res = findEntity' ln duplicatedDecls++         return (res,duplicatedDecls)+      ((r,d),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual d) `shouldBe` "[DupDef.Dd1.toplevel x = DupDef.Dd1.c GHC.Num.* x]"+      ("1" ++ show r) `shouldBe` "1False"+      -}++    -- -----------------------------------------------------------------++    it "Finds an entity in [HsBind Name]" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (MatchGroup matches _)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (HsLet decls _)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (HsLet _ e1)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (HsLet decls _)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (PatBind pat rhs _ _ _)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (Match _ _ rhs)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (LetStmt binds)" $ do+      pending -- "write this test"++    -- -----------------------------------------------------------------++    it "Finds an entity in (BindStmt _ rhs _ _)" $ do+      pending -- "write this test"+++  -- ---------------------------------------------++  describe "modIsExported" $ do+    it "Returns True if the module is explicitly exported" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let renamed = fromJust $ GHC.tm_renamed_source t+      let (Just (modName,_)) = getModuleName parsed++      (modIsExported modName renamed) `shouldBe` True++    it "Returns True if the module is exported by default" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare1.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let renamed = fromJust $ GHC.tm_renamed_source t+      let (Just (modName,_)) = getModuleName parsed++      (modIsExported modName renamed) `shouldBe` True++    it "Returns False if the module is explicitly not exported" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare2.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let renamed = fromJust $ GHC.tm_renamed_source t+      let (Just (modName,_)) = getModuleName parsed++      (modIsExported modName renamed) `shouldBe` False++  -- ---------------------------------------------++  describe "isExported" $ do+    it "returns True if a GHC.Name is exported" $ do+      t <- ct $ parsedFileGhc "./Renaming/B1.hs"++      let+        comp = do+         parsed <- getRefactParsed+         nm <- getRefactNameMap++         let (Just myFringe) = locToNameRdrPure nm (11,1) parsed+         let (Just sumSquares) = locToNameRdrPure nm (15,1) parsed++         exMyFring <- isExported myFringe+         exSumSquares <- isExported sumSquares++         return (myFringe,exMyFring,sumSquares,exSumSquares)+      ((mf,emf,ss,ess),_s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t}) testOptions++      (showGhcQual mf) `shouldBe` "Renaming.B1.myFringe"+      emf `shouldBe` True+      (showGhcQual ss) `shouldBe` "Renaming.B1.sumSquares"+      ess `shouldBe` False++  -- ---------------------------------------------++  describe "addHiding" $ do+    it "add a hiding entry to the imports with no existing hiding" $ do+      t1 <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         clearParsedModule+         t2 <- parseSourceFileTest "./DupDef/Dd2.hs"+         let renamed2 = fromJust $ GHC.tm_renamed_source t2++         let parsed1 = GHC.pm_parsed_source $ GHC.tm_parsed_module t1+         let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2++         -- let mn = locToName (4,1) renamed1+         -- let (Just (GHC.L _ _n)) = mn++         let Just (modName,_) = getModuleName parsed1+         let+           n1 = mkRdrName "n1"+           n2 = mkRdrName "n2"+         res  <- addHiding modName parsed2 [n1,n2]+         putRefactParsed res emptyAnns++         return (res,renamed2)+      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t1}) testOptions+      -- ((_r,_r2),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t1}) testOptions++      (sourceFromState s) `shouldBe` "module DupDef.Dd2 where\n\nimport DupDef.Dd1 hiding (n1,n2)\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"++    ------------------------------------++    it "adds a hiding entry to the imports with an existing hiding" $ do+      t1 <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do++         clearParsedModule+         t2 <- parseSourceFileTest "./DupDef/Dd3.hs"+         let renamed2 = fromJust $ GHC.tm_renamed_source t2++         let parsed1 = GHC.pm_parsed_source $ GHC.tm_parsed_module t1+         let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2++         -- let mn = locToName (4,1) renamed1+         -- let (Just (GHC.L _ _n)) = mn++         let Just (modName,_) = getModuleName parsed1+         let+           n1 = mkRdrName "n1"+           n2 = mkRdrName "n2"+         res  <- addHiding modName parsed2 [n1,n2]++         return (res,renamed2)+      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t1}) testOptions+      (sourceFromState s) `shouldBe` "module DupDef.Dd3 where\n\nimport DupDef.Dd1 hiding (dd,n1,n2)\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"++  -- ---------------------------------------------++  describe "equivalentNameInNewMod" $ do+    it "finds equivalent name for normal import" $ do+      let+        ctc = cdAndDo "./test/testdata/cabal/foo"+      let+        comp = do+          parseSourceFileGhc "./src/Foo/Bar.hs"+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          let Just old = locToNameRdrPure nm (3,1) parsed+          parseSourceFileGhc "./src/Main.hs"+          [equiv] <- equivalentNameInNewMod old+          return (old,equiv)++      ((o,e),_s) <- ctc $ runRefactGhc comp initialState testOptions+      -- ((o,e),_s) <- ctc $ runRefactGhc comp initialLogOnState testOptions+      (showGhcQual (o,e)) `shouldBe` "(Foo.Bar.bar, Foo.Bar.bar)"+      -- putStrLn( "(GHC.nameUnique o,GHC.nameUnique e)" ++ (showGhcQual (GHC.nameUnique o,GHC.nameUnique e)))+      -- (GHC.nameUnique o == GHC.nameUnique e) `shouldBe` True -- seems to reuse the already loaded names?++    -- ---------------------------------++    it "finds equivalent name for qualified import" $ do+      let+        ctc = cdAndDo "./test/testdata/cabal/cabal4"+      let+        comp = do+          parseSourceFileGhc "./src/Foo/Bar.hs"+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          let Just old = locToNameRdrPure nm (3,1) parsed+          parseSourceFileGhc "./src/main4.hs"+          parsed' <- getRefactParsed+          [equiv] <- equivalentNameInNewMod old++          let Just ((GHC.L _l new)) = locToRdrName (11,12) parsed'+          return (old,equiv,new)++      ((o,e,n),_s) <- ctc $ runRefactGhc comp initialState testOptions+      (showGhcQual (o,e,n)) `shouldBe` "(Foo.Bar.baz, Foo.Bar.baz, B.baz)"+      -- (showGhcQual (GHC.nameUnique o,GHC.nameUnique e)) `shouldBe` ""+      -- (GHC.nameUnique o == GHC.nameUnique e) `shouldBe` True -- seems to reuse the already loaded names?++  -- ---------------------------------------------++  describe "usedWithoutQualR" $ do+    it "returns True if the identifier is used unqualified Dd1" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap++          let Just n@name = locToNameRdrPure nm (14,21) parsed+          let res = usedWithoutQualR name parsed+          return (res,n,name)++      ((r,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (GHC.getOccString n2) `shouldBe` "zip"+      (showGhcQual n1) `shouldBe` "GHC.List.zip"+      r `shouldBe` True++    -- ---------------------------------++    it "returns True if the identifier is used unqualified Dd3" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd3.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap++          let Just n@name = locToNameRdrPure nm (8,1) parsed+          let res = usedWithoutQualR name parsed+          return (res,n,name)++      ((r,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (GHC.getOccString n2) `shouldBe` "mm"+      (showGhcQual n1) `shouldBe` "DupDef.Dd3.mm"+      r `shouldBe` True++    -- ---------------------------------++    it "returns False if the identifier is used qualified" $ do+      t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap++          let Just n@name = locToNameRdrPure nm (36,12) parsed+          let Just (GHC.L _ namep) = locToRdrName (36,12) parsed+          let res = usedWithoutQualR name parsed+          return (res,namep,name,n)+      ((r,np,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (myShow np) `shouldBe` "Qual:G:gshow"+      (myShow $ GHC.getRdrName n1) `shouldBe` "Exact:Data.Generics.Text.gshow"+      (showGhcQual $ GHC.getRdrName n1) `shouldBe` "Data.Generics.Text.gshow"+      (showGhcQual n2) `shouldBe` "Data.Generics.Text.gshow"+      r `shouldBe` False++  -- ---------------------------------------------++  describe "isExplicitlyExported" $ do+    it "Returns True if the identifier is explicitly exported" $ do+      pending -- "write this "++    it "Returns False if the identifier is not explicitly exported" $ do+      pending -- "write this "++  -- ---------------------------------------------++  describe "causeNameClashInExports" $ do+    it "Returns True if there is a clash" $ do++      t <- ct $ parsedFileGhc "./Renaming/ConflictExport.hs"+      let nm = initRdrNameMap t+      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t++      -- Is this the right module?+      let Just (modName,_) = getModuleName parsed++      let Just myFringe = locToNameRdrPure nm (9,1) parsed+      (showGhcQual myFringe) `shouldBe` "Renaming.ConflictExport.myFringe"++      -- old name is myFringe+      -- new name is "Renaming.ConflictExport.fringe"+      let newName = mkTestGhcName 1 (Just modu) "fringe"++      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringe"++      (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringe"++      let res = causeNameClashInExports nm myFringe newName modName parsed+      res `shouldBe` True++    it "Returns False if there is no clash" $ do+      t <- ct $ parsedFileGhc "./Renaming/ConflictExport.hs"+      let nm = initRdrNameMap t+      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t++      -- Is this the right module?+      let Just (modName,_) = getModuleName parsed++      let Just myFringe = locToNameRdrPure nm (9,1) parsed+      (showGhcQual myFringe) `shouldBe` "Renaming.ConflictExport.myFringe"++      -- old name is myFringe+      -- new name is "Renaming.ConflictExport.fringe"+      let newName = mkTestGhcName 1 (Just modu) "fringeOk"++      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringeOk"++      (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringeOk"++      let res = causeNameClashInExports nm myFringe newName modName parsed+      res `shouldBe` False++  -- ---------------------------------------++  describe "rmQualifier" $ do+    it "removes the qualifiers from a list of identifiers in a given syntax phrase" $ do+      let+        comp = do+          parseSourceFileGhc "./TypeUtils/Qualified.hs"+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          nm <- getRefactNameMap++          let Just foo = locToNameRdrPure nm (5, 1) parsed+          let Just baz = locToNameRdrPure nm (5, 27) parsed++          let [fooDecl] = definingDeclsRdrNames nm [foo] decls False False++          res <- rmQualifier [baz] fooDecl+          return (res,fooDecl,baz)++      ((r,d,n1),_s) <- ct $ runRefactGhc comp initialState  testOptions+      (showGhcQual n1) `shouldBe` "TypeUtils.C.baz"+      (showGhcQual d) `shouldBe` "main = return TypeUtils.C.baz"+      (showGhcQual r) `shouldBe` "main = return baz"++    it "Removes the qualifiers and updates the tokens" $ do+      pending -- "Is this needed?"++  -- ---------------------------------------++  describe "usedByRhs" $ do+    it "returns True if a given identifier is used in the RHS of a syntax element" $ do+      t <- ct $ parsedFileGhc "./MoveDef/Demote.hs"+      let+        comp = do+          parsed <- getRefactParsed+          declsp <- liftT $ hsDecls parsed+          nm <- getRefactNameMap++          let Just tl   = locToNameRdrPure nm (4,1) parsed+          let Just name = locToNameRdrPure nm (7,1) parsed+          let decls = definingDeclsRdrNames nm [tl] declsp False False+          decls' <- rmQualifier [name] decls++          let res = usedByRhsRdr nm decls' [name]++          return (res,decls,tl,name)++      ((r,d,n1,n2),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n1) `shouldBe` "MoveDef.Demote.toplevel"+      (showGhcQual n2) `shouldBe` "MoveDef.Demote.c"+      (showGhcQual d) `shouldBe` "[toplevel x = c * x]"+      r `shouldBe` True++  -- ---------------------------------------++  describe "autoRenameLocalVar" $ do+    it "renames an identifier if it is used and updates tokens" $ do+      t <- ct $ parsedFileGhc "./Demote/WhereIn4.hs"+      let+        comp = do+          parsed <- getRefactParsed+          nm <- getRefactNameMap+          tlDecls <- liftT $ hsDecls parsed++          let Just tl   = locToNameRdrPure nm (11,1) parsed+          let Just name = locToNameRdrPure nm (11,21) parsed+          let [decls] = definingDeclsRdrNames nm [tl] tlDecls False True+          decls' <- autoRenameLocalVar name decls++          return (decls',decls,tl,name)++      ((r,d,n1,n2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((r,d,n1,n2),s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      (showGhcQual n1) `shouldBe` "Demote.WhereIn4.sumSquares"+      (showGhcQual n2) `shouldBe` "p"+      (showGhcQual d) `shouldBe` "sumSquares x y\n  = sq p x + sq p y\n  where\n      p = 2"+      (showGhcQual r) `shouldBe` "sumSquares x y\n  = sq p_1 x + sq p_1 y\n  where\n      p_1 = 2"+      (exactPrintFromState s r) `shouldBe` "\n\n--A definition can be demoted to the local 'where' binding of a friend declaration,\n--if it is only used by this friend declaration.\n\n--Demoting a definition narrows down the scope of the definition.\n--In this example, demote the top level 'sq' to 'sumSquares'\n--In this case (there is single matches), if possible,\n--the parameters will be folded after demoting and type sigature will be removed.\n\nsumSquares x y = sq p_1 x + sq p_1 y\n         where p_1=2"++  -- ---------------------------------------++  describe "mkNewName" $ do+    it "Makes a new name that does not clash with existing ones" $ do+      (mkNewName "f" ["f"] 0) `shouldBe` "f_1"+      (mkNewName "f" ["g"] 0) `shouldBe` "f"+      (mkNewName "f" ["g","f_1","f"] 0) `shouldBe` "f_2"++  -- ---------------------------------------++  describe "addImportDecl" $ do+    it "adds an import entry to a module with already existing, non conflicting imports and other declarations" $ do+      t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"+      let+        comp = do+         clearParsedModule+         parseSourceFileGhc "./DupDef/Dd2.hs"+         renamed2 <- getRefactRenamed+         parsed2 <- getRefactParsed++         let listModName  = GHC.mkModuleName "Data.List"+         res  <- addImportDecl parsed2 listModName Nothing False False False Nothing False []+         putRefactParsed res emptyAnns++         return (res,renamed2)+      ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module DupDef.Dd2 where\n\nimport DupDef.Dd1\nimport Data.List\n\n\nf2 x = ff (x+1)\n\nmm = 5\n\n\n"++    -- ---------------------------------++    it "adds an import entry to a module with some declaration, but no explicit imports." $ do+      t <- ct $ parsedFileGhc "./TypeUtils/Simplest.hs"+      let+        comp = do++         let renamed1 = fromJust $ GHC.tm_renamed_source t+         parsed <- getRefactParsed++         let listModName  = GHC.mkModuleName "Data.List"+         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []+         putRefactParsed res emptyAnns++         return (res,renamed1)+      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module Simplest where\nimport Data.List\n\n\nsimple x = x\n"++    -- ---------------------------------++    it "adds an import entry to a module with explicit imports, but no declarations." $ do+      t <- ct $ parsedFileGhc "./TypeUtils/JustImports.hs"+      let+        comp = do+         let renamed1 = fromJust $ GHC.tm_renamed_source t+         parsed <- getRefactParsed++         let listModName  = GHC.mkModuleName "Data.List"+         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []+         putRefactParsed res emptyAnns++         return (res,renamed1)+      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module JustImports where\n\nimport Data.Maybe\nimport Data.List\n"++    -- ---------------------------------++    it "adds an import entry to a module with no declarations and no explicit imports" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/Empty.hs"+      let+        comp = do+         renamed1 <- getRefactRenamed+         parsed <- getRefactParsed++         let listModName  = GHC.mkModuleName "Data.List"+         res  <- addImportDecl parsed listModName Nothing False False False Nothing False []+         putRefactParsed res emptyAnns++         return (res,renamed1)+      ((_r,_r2),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (sourceFromState s) `shouldBe` "module Empty where\nimport Data.List\n\n"+++  -- ---------------------------------------++  describe "addItemsToImport" $ do+    it "adds an item to an import entry with no items" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/JustImports.hs"+      let+        comp = do+         parsed <- getRefactParsed++         let modName  = GHC.mkModuleName "Data.Maybe"+         -- itemName <- mkNewGhcName Nothing "fromJust"+         let  itemName = mkRdrName "fromJust"++         res  <- addItemsToImport modName Nothing (Left [itemName]) parsed+         putRefactParsed res emptyAnns++         return (res)+      ((_r),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      -- This is the correct behavior. If the import doesn't have an import list, creating+      -- one for an item effectively reduces the imported interface.+      (sourceFromState s) `shouldBe` "module JustImports where\n\nimport Data.Maybe\n"++-- Not sure if this should be a test+{-    it "Try adding more than one item to an existing import entry with no items, using separate calls." $ do+      let+        comp = do+         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/JustImports.hs"+         -- clearParsedModule+         let renamed1 = fromJust $ GHC.tm_renamed_source t1++         let modName  = GHC.mkModuleName "Data.Maybe"+         itemName <- mkNewGhcName Nothing "fromJust"++         res  <- addItemsToImport modName renamed1 [itemName] --listModName Nothing False False False Nothing False []++         itemName2 <- mkNewGhcName Nothing "isJust"++         res2 <- addItemsToImport modName res [itemName2]+         toks <- fetchToks++         return (res2,toks,renamed,_toks1)+      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp+      (GHC.showRichTokenStream t) `shouldBe` "module JustImports where\n\n import Data.Maybe (fromJust,isJust)\n "+-}++    -- ---------------------------------++    it "adds an item to an import entry with existing items" $ do+      t <- ct $ parsedFileGhc "./TypeUtils/SelectivelyImports.hs"+      let+        comp = do+         parsed <-getRefactParsed++         let modName  = GHC.mkModuleName "Data.Maybe"+         let  itemName = mkRdrName "isJust"++         res  <- addItemsToImport modName Nothing (Left [itemName]) parsed+         putRefactParsed res emptyAnns+         return (res)+      ((_r),s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      (sourceFromState s) `shouldBe` "module SelectivelyImports where\n\nimport Data.Maybe (fromJust,isJust)\n\n__ = id\n"++{- -- test after properly inserting conditional identifier+    it "Add an item to an import entry with existing items, passing existing conditional identifier." $ do+      let+        comp = do+         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"+         -- clearParsedModule+         let renamed1 = fromJust $ GHC.tm_renamed_source t1++         let modName  = GHC.mkModuleName "Data.Maybe"+         itemName <- mkNewGhcName Nothing "isJust"+         conditionalId <- mkNewGhcName Nothing "fromJust"++         res  <- addItemsToImport modName renamed1 [itemName] (Just conditionalId)+         toks <- fetchToks++         return (res,toks,renamed1,_toks1)+      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp+      (GHC.showRichTokenStream t) `shouldBe` "module SelectivelyImports where\n\n import Data.Maybe (fromJust,isJust)\n\n __ = id\n "++    it "Add an item to an import entry with existing items, passing missing conditional identifier" $ do+      let+        comp = do+         (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"+         -- clearParsedModule+         let renamed1 = fromJust $ GHC.tm_renamed_source t1++         let modName  = GHC.mkModuleName "Data.Maybe"+         itemName <- mkNewGhcName Nothing "isJust"++         res  <- addItemsToImport modName renamed1 [itemName] (Just itemName)+         toks <- fetchToks++         return (res,toks,renamed1,_toks1)+      ((_r,t,r2,tk2),s) <- ct $ runRefactGhcState comp+      (GHC.showRichTokenStream t) `shouldBe` "module SelectivelyImports where\n\n import Data.Maybe (fromJust)\n\n __ = id\n "+-}++  -- ---------------------------------------++  describe "addItemsToExport" $ do+    it "adds an item to an export entry with no items" $ do+      pendingWith "write these tests"++  -- ---------------------------------------++  describe "unspace" $ do+    it "Reduces all sequences of more than one space to a single one" $ do+      (unspace []) `shouldBe` []+      (unspace "a") `shouldBe` "a"+      (unspace "a bc") `shouldBe` "a bc"+      (unspace "a  bc") `shouldBe` "a bc"+      (unspace "ab   c") `shouldBe` "ab c"+      (unspace "  ab   c") `shouldBe` " ab c"+      (unspace "abc    ") `shouldBe` "abc "++  -- ---------------------------------------++  describe "isFieldName" $ do+    it "returns True if a Name is a field name" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field3.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just nf = locToNameRdrPure nm (10,21) parsed+      let Just n  = locToNameRdrPure nm (10,1)  parsed++      (showGhcQual n) `shouldBe` "Field3.absPoint"+      (showGhcQual nf) `shouldBe` "Field3.pointx"++  -- ---------------------------------------++  describe "name predicates" $ do+    it "classifies names" $ do+      t <- ct $ parsedFileGhc "./Cons.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let nm = initRdrNameMap t++      let Just n1 = locToNameRdrPure nm (3,6)  parsed+      let Just n2 = locToNameRdrPure nm (3,12) parsed+      let Just n3 = locToNameRdrPure nm (3,16) parsed+      let Just n4 = locToNameRdrPure nm (5,1)  parsed+      let Just n5 = locToNameRdrPure nm (8,5)  parsed++      (showGhcQual n1) `shouldBe` "Main.Foo"+      "11" ++ (show $ GHC.isTyVarName n1)   `shouldBe` "11False"+      "12" ++ (show $ GHC.isTyConName n1)   `shouldBe` "12True"+      "13" ++ (show $ GHC.isDataConName n1) `shouldBe` "13False"+      "14" ++ (show $ GHC.isValName n1)     `shouldBe` "14False"+      "15" ++ (show $ GHC.isVarName n1)     `shouldBe` "15False"++      (showGhcQual n2) `shouldBe` "Main.Ff"+      "21" ++ (show $ GHC.isTyVarName n2)   `shouldBe` "21False"+      "22" ++ (show $ GHC.isTyConName n2)   `shouldBe` "22False"+      "23" ++ (show $ GHC.isDataConName n2) `shouldBe` "23True"+      "24" ++ (show $ GHC.isValName n2)     `shouldBe` "24True"+      "25" ++ (show $ GHC.isVarName n2)     `shouldBe` "25False"++      (showGhcQual n3) `shouldBe` "Main.fooA" -- field name+      "31" ++ (show $ GHC.isTyVarName n3)   `shouldBe` "31False"+      "32" ++ (show $ GHC.isTyConName n3)   `shouldBe` "32False"+      "33" ++ (show $ GHC.isDataConName n3) `shouldBe` "33False"+      "34" ++ (show $ GHC.isValName n3)     `shouldBe` "34True"+      "35" ++ (show $ GHC.isVarName n3)     `shouldBe` "35True"++      (showGhcQual n4) `shouldBe` "Main.xx"+      "41" ++ (show $ GHC.isTyVarName n4)   `shouldBe` "41False"+      "42" ++ (show $ GHC.isTyConName n4)   `shouldBe` "42False"+      "43" ++ (show $ GHC.isDataConName n4) `shouldBe` "43False"+      "44" ++ (show $ GHC.isValName n4)     `shouldBe` "44True"+      "45" ++ (show $ GHC.isVarName n4)     `shouldBe` "45True"++      (showGhcQual n5) `shouldBe` "GHC.Classes.=="+      "51" ++ (show $ GHC.isTyVarName n5)   `shouldBe` "51False"+      "52" ++ (show $ GHC.isTyConName n5)   `shouldBe` "52False"+      "53" ++ (show $ GHC.isDataConName n5) `shouldBe` "53False"+      "54" ++ (show $ GHC.isValName n5)     `shouldBe` "54True"+      "55" ++ (show $ GHC.isVarName n5)     `shouldBe` "55True"++  -- ---------------------------------------------------------------------++  describe "rdrName2Name" $ do++    it "finds a Name for a top-level RdrName" $ do+      t <- ct $ parsedFileGhc "./TokenTest.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let+        comp = do+          let (Just rdr)  = locToRdrName (5,1) parsed+              -- (Just name) = locToName    (5,1) renamed+          nname <- rdrName2Name rdr+          return (rdr,nname)+      ((r,n),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((r,n),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (r,n)) `shouldBe` "(bob, TokenTest.bob)"++    -- ---------------------------------++    it "finds a Name for a local RdrName" $ do+      t <- ct $ parsedFileGhc "./TokenTest.hs"+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t++      let+        comp = do+          let (Just rdr)  = locToRdrName (14,7) parsed+          nname <- rdrName2Name rdr+          return (rdr,nname)+      ((r,n),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+      -- ((r,n),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual (r,n)) `shouldBe` "(bar, bar)"    -- ---------------------------------------

test/UtilsSpec.hs view

@@ -582,11 +582,11 @@     it "loads a file from a sub directory" $ do       t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareS.hs"       fileName <- canonicalizePath "./test/testdata/FreeAndDeclared/DeclareS.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t+      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t       let         comp = do           parseSourceFileGhc fileName-          r <- hsFreeAndDeclaredPNs renamed+          r <- hsFreeAndDeclaredPNs parsed           return r       ((res),_s) <- cdAndDo "./test/testdata/FreeAndDeclared" $                      runRefactGhc comp initialState testOptions@@ -597,5 +597,19 @@       -- Declared Vars       (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd res)) `shouldBe` "[(FreeAndDeclared.DeclareS.c, (6, 1))]" --- ---------------------------------------------------------------------+  -- ------------------------------------------------------------------- +  describe "stripCallStack" $ do+    it "strips a call stack from the end of an error string" $ do+      let s = "\nThe identifier is not a local function/pattern name!\nCallStack (from HasCallStack):\n  error, called at ../src/Language/Haskell/Refact/Refactoring/MoveDef.hs:155:12 in main:Language.Haskell.Refact.Refactoring.MoveDef"+      (stripCallStack s) `shouldBe` "\nThe identifier is not a local function/pattern name!"++    it "noops if no call stack from the end of an error string" $ do+      let s = "\nThe identifier is not a local function/pattern name!"+      (stripCallStack s) `shouldBe` "\nThe identifier is not a local function/pattern name!"++    it "noops if no call stack from the end of an error string, trailing nl" $ do+      let s = "\nThe identifier is not a local function/pattern name!\n"+      (stripCallStack s) `shouldBe` "\nThe identifier is not a local function/pattern name!\n"++-- ---------------------------------------------------------------------

+ test/testdata/AddOneParameter/A1.expected.hs view

@@ -0,0 +1,10 @@+module AddOneParameter.A1 where++import AddOneParameter.C1++import AddOneParameter.D1++sumSq xs = sum (map (sq sq_f) xs) + sumSquares xs + sumSquares1 xs++main = sumSq [1..4]+

+ test/testdata/AddOneParameter/A1.hs view

@@ -0,0 +1,10 @@+module AddOneParameter.A1 where++import AddOneParameter.C1++import AddOneParameter.D1++sumSq xs = sum (map sq xs) + sumSquares xs + sumSquares1 xs++main = sumSq [1..4]+

+ test/testdata/AddOneParameter/A2.expected.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.A2 where++import AddOneParameter.C2++import AddOneParameter.D2++sumSq xs = sum (map (sq sq_f) xs) + sumSquares xs + sumSquares1 xs++sq_f_2  = 2++main = sumSq [1..4]+

+ test/testdata/AddOneParameter/A2.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.A2 where++import AddOneParameter.C2++import AddOneParameter.D2++sumSq xs = sum (map sq xs) + sumSquares xs + sumSquares1 xs++sq_f_2  = 2++main = sumSq [1..4]+

+ test/testdata/AddOneParameter/A3.expected.hs view

@@ -0,0 +1,6 @@+module AddOneParameter.A3 where++import AddOneParameter.D3++main = (sumSquares sumSquares_y) [1..4]+

+ test/testdata/AddOneParameter/A3.hs view

@@ -0,0 +1,6 @@+module AddOneParameter.A3 where++import AddOneParameter.D3++main = sumSquares [1..4]+

+ test/testdata/AddOneParameter/C1.expected.hs view

@@ -0,0 +1,10 @@+module AddOneParameter.C1 where++import AddOneParameter.D1++sumSquares1 (x:xs) = (sq sq_f) x + sumSquares1 xs++sumSquares1 [] = 0+++

+ test/testdata/AddOneParameter/C1.hs view

@@ -0,0 +1,10 @@+module AddOneParameter.C1 where ++import AddOneParameter.D1++sumSquares1 (x:xs) = sq x + sumSquares1 xs++sumSquares1 [] = 0+++

+ test/testdata/AddOneParameter/C2.expected.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.C2 where++import AddOneParameter.D2++sumSquares1 (x:xs) = (sq sq_f) x + sumSquares1 xs++sumSquares1 [] = 0++sq_f_1 = 0+++

+ test/testdata/AddOneParameter/C2.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.C2 where++import AddOneParameter.D2++sumSquares1 (x:xs) = sq x + sumSquares1 xs++sumSquares1 [] = 0++sq_f_1 = 0+++

+ test/testdata/AddOneParameter/D1.expected.hs view

@@ -0,0 +1,15 @@+module AddOneParameter.D1 where++{-add parameter 'f' to function  'sq' . This refactoring+  affects module 'D1', 'C1' and 'A1'-}++sumSquares (x:xs) = (sq sq_f) x + sumSquares xs++sumSquares [] = 0++sq f x = x ^ pow++sq_f = undefined++pow =2+

+ test/testdata/AddOneParameter/D1.hs view

@@ -0,0 +1,13 @@+module AddOneParameter.D1 where++{-add parameter 'f' to function  'sq' . This refactoring+  affects module 'D1', 'C1' and 'A1'-}++sumSquares (x:xs) = sq x + sumSquares xs++sumSquares [] = 0++sq x = x ^ pow++pow =2+

+ test/testdata/AddOneParameter/D2.expected.hs view

@@ -0,0 +1,16 @@+module AddOneParameter.D2 where++{-add parameter 'f' to function  'sq' . This refactoring+  affects module 'D2', 'C2' and 'A2'. It aims to test the+  creating of default parameter name.-}++sumSquares (x:xs) = (sq sq_f) x + sumSquares xs++sumSquares [] = 0++sq f x = x ^ pow++sq_f = undefined++pow =2+

+ test/testdata/AddOneParameter/D2.hs view

@@ -0,0 +1,14 @@+module AddOneParameter.D2 where++{-add parameter 'f' to function  'sq' . This refactoring+  affects module 'D2', 'C2' and 'A2'. It aims to test the+  creating of default parameter name.-}++sumSquares (x:xs) = sq x + sumSquares xs++sumSquares [] = 0++sq x = x ^ pow++pow =2+

+ test/testdata/AddOneParameter/D3.expected.hs view

@@ -0,0 +1,14 @@+module AddOneParameter.D3(sumSquares,sumSquares_y) where++{- add parameter 'y' to 'sumSquares'. 'sumSquares_y_1' to be added to the+   export list -}++sumSquares y (x:xs) = sq x + (sumSquares y) xs+sumSquares y [] = 0++sumSquares_y = undefined++sq x = x ^ pow++pow =2+

+ test/testdata/AddOneParameter/D3.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.D3(sumSquares) where++{- add parameter 'y' to 'sumSquares'. 'sumSquares_y_1' to be added to the+   export list -}++sumSquares (x:xs) = sq x + sumSquares xs+sumSquares [] = 0++sq x = x ^ pow++pow =2+

+ test/testdata/AddOneParameter/FunIn1.expected.hs view

@@ -0,0 +1,13 @@+module FunIn1 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'+foo :: a -> Int -> Int+foo y  x= h + t where (h,t) = head $ zip [1..x] [3..15] {-There+is a comment-}++foo_y = undefined++main :: Int+main = (foo foo_y) 4

+ test/testdata/AddOneParameter/FunIn1.hs view

@@ -0,0 +1,11 @@+module FunIn1 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'+foo :: Int -> Int+foo  x= h + t where (h,t) = head $ zip [1..x] [3..15] {-There+is a comment-}++main :: Int+main = foo 4

+ test/testdata/AddOneParameter/FunIn2.expected.hs view

@@ -0,0 +1,13 @@+module FunIn2 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int->Int+main =(foo foo_y)  where foo :: a -> Int -> Int+                         foo_y_1 =15+                         foo y x= h + t where (h,t) = head $ zip [1..x] [3..foo_y_1]++                         foo_y = undefined+

+ test/testdata/AddOneParameter/FunIn2.hs view

@@ -0,0 +1,11 @@+module FunIn2 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int->Int+main =foo  where foo :: Int -> Int+                 foo_y_1 =15+                 foo x= h + t where (h,t) = head $ zip [1..x] [3..foo_y_1]+

+ test/testdata/AddOneParameter/FunIn3.expected.hs view

@@ -0,0 +1,14 @@+module FunIn3 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int+main =let foo :: a -> Int -> Int+          foo y  x= h + t+               where (h,t) = head $ zip [1..x] [3..15]++          foo_y = undefined  in (let a=10+                                     b=10+                                 in (foo foo_y) 5+a+b)

+ test/testdata/AddOneParameter/FunIn3.hs view

@@ -0,0 +1,12 @@+module FunIn3 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int+main =let foo :: Int -> Int+          foo  x= h + t+               where (h,t) = head $ zip [1..x] [3..15]  in (let a=10+                                                                b=10+                                                            in foo 5+a+b)

+ test/testdata/AddOneParameter/FunIn4.expected.hs view

@@ -0,0 +1,11 @@+module FunIn4 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int+main = sum [x+4 |let foo y =[1..4]++                     foo_y = undefined, x<-(foo foo_y)]+

+ test/testdata/AddOneParameter/FunIn4.hs view

@@ -0,0 +1,9 @@+module FunIn4 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main::Int+main = sum [x+4 |let foo =[1..4], x<-foo]+

+ test/testdata/AddOneParameter/FunIn5.hs view

@@ -0,0 +1,12 @@+module FunIn5 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'h' to 'foo' will fail because of name clash.++foo :: Int -> Int+foo x= h + t where (h,t) = head $ zip [1..x] [3..15]++main :: Int+main = foo 4+

+ test/testdata/AddOneParameter/FunIn6.expected.hs view

@@ -0,0 +1,13 @@+module FunIn6 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main :: IO Integer+main = do+  let foo y = return [1..4]++      foo_y = undefined+  x <- (foo foo_y)+  return (sum x)

+ test/testdata/AddOneParameter/FunIn6.hs view

@@ -0,0 +1,11 @@+module FunIn6 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'y' to 'foo'++main :: IO Integer+main = do+  let foo = return [1..4]+  x <- foo+  return (sum x)

+ test/testdata/AddOneParameter/MultiFun1.expected.hs view

@@ -0,0 +1,13 @@+module MultiFun1 where++{-++Add a parameter to every equation for the function foo.++-}++foo x [] = []+foo x xs = [1]++foo_x = undefined+

+ test/testdata/AddOneParameter/MultiFun1.hs view

@@ -0,0 +1,11 @@+module MultiFun1 where++{-++Add a parameter to every equation for the function foo.++-}++foo [] = []+foo xs = [1]+

+ test/testdata/AddOneParameter/Nested.expected.hs view

@@ -0,0 +1,14 @@+module AddOneParameter.Nested(sumSquares,sumSquares_y) where++{- add parameter 'y' to 'sumSquares'. 'sumSquares_y_1' to be added to the+   export list -}++sumSquares y (x:xs) = sq x + (sumSquares y) xs + foo xs+  where foo a = (sumSquares y) a + 1+sumSquares y [] = 0++sumSquares_y = undefined++sq x = x ^ pow++pow =2

+ test/testdata/AddOneParameter/Nested.hs view

@@ -0,0 +1,12 @@+module AddOneParameter.Nested(sumSquares) where++{- add parameter 'y' to 'sumSquares'. 'sumSquares_y_1' to be added to the+   export list -}++sumSquares (x:xs) = sq x + sumSquares xs + foo xs+  where foo a = sumSquares a + 1+sumSquares [] = 0++sq x = x ^ pow++pow =2

+ test/testdata/AddOneParameter/PatIn1.expected.hs view

@@ -0,0 +1,12 @@+module PatIn1 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'x' to 'foo'+foo :: a -> Int+foo x = h + t where (h,t) = head $ zip [1..10] [3..15]++foo_x = undefined++main :: Int+main = (foo foo_x)

+ test/testdata/AddOneParameter/PatIn1.hs view

@@ -0,0 +1,10 @@+module PatIn1 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'x' to 'foo'+foo :: Int+foo = h + t where (h,t) = head $ zip [1..10] [3..15]++main :: Int+main = foo

+ test/testdata/AddOneParameter/PatIn2.hs view

@@ -0,0 +1,10 @@+module PatIn2 where++--Default parameters can be added to definition of functions and simple constants.++--In this example: add parameter 'x' to '(h,t)' will fail.+foo :: Int+foo = h + t where (h,t) = head $ zip [1..10] [3..15]++main :: Int+main = foo

test/testdata/LiftOneLevel/C1.hs view

@@ -3,10 +3,9 @@ import LiftOneLevel.D1 hiding (main)  sumSquares1 (x:xs) = sq x + sumSquares1 xs- + sumSquares1 [] = 0-  + sq x =x ^pow  pow = 2-

test/testdata/LiftOneLevel/C1.hs.expected view

@@ -9,4 +9,3 @@ sq x =x ^pow  pow = 2-

test/testdata/LiftOneLevel/D1.hs view

@@ -7,7 +7,7 @@   where      sq x = x ^ pow      pow =2- + sumSquares [] = 0  main = sumSquares [1..4]

test/testdata/Renaming/ConstructorIn3.hs view

@@ -5,7 +5,7 @@ --Any type variable can be renamed.  --Rename tyoe variable 'a' in BTree to 'b'- + data BTree a = Empty | T a (BTree a) (BTree a)                deriving Show @@ -20,4 +20,4 @@    | otherwise = T tval (insert val left) right  main :: BTree Int-main = buildtree [3,1,2] +main = buildtree [3,1,2]

test/testdata/Renaming/D1.hs view

@@ -2,9 +2,9 @@  {-Rename data constructor `Tree` to `AnotherTree`.   This refactoring affects module `D1', 'B1' and 'C1' -}-   -data Tree a = Leaf a | Branch (Tree a) (Tree a)  +data Tree a = Leaf a | Branch (Tree a) (Tree a)+ fringe :: Tree a -> [a] fringe (Leaf x ) = [x] fringe (Branch left right) = fringe left ++ fringe right@@ -18,7 +18,7 @@    isNotSame a b = a /= b  sumSquares (x:xs) = sq x + sumSquares xs-    where sq x = x ^pow +    where sq x = x ^pow           pow = 2  sumSquares [] = 0

test/testdata/Renaming/D3.hs view

@@ -2,9 +2,9 @@  {-Rename class name 'SameOrNot' to 'Same'.   This refactoring affects module `D3', 'B3' and 'C3' -}-   -data Tree a = Leaf a | Branch (Tree a) (Tree a)  +data Tree a = Leaf a | Branch (Tree a) (Tree a)+ fringe :: Tree a -> [a] fringe (Leaf x ) = [x] fringe (Branch left right) = fringe left ++ fringe right@@ -18,7 +18,7 @@    isNotSame a b = a /= b  sumSquares (x:xs) = sq x + sumSquares xs-    where sq x = x ^pow +    where sq x = x ^pow           pow = 2  sumSquares [] = 0

test/testdata/Renaming/D4.hs view

@@ -2,9 +2,9 @@  {-Rename instance name 'isSame'' to 'sameOrNot'.   This refactoring affects module `D4', 'B4' and 'C4' -}-   -data Tree a = Leaf a | Branch (Tree a) (Tree a)  +data Tree a = Leaf a | Branch (Tree a) (Tree a)+ fringe :: Tree a -> [a] fringe (Leaf x ) = [x] fringe (Branch left right) = fringe left ++ fringe right@@ -18,7 +18,7 @@    isNotSame a b = a /= b  sumSquares (x:xs) = sq x + sumSquares xs-    where sq x = x ^pow +    where sq x = x ^pow           pow = 2  sumSquares [] = 0

test/testdata/Renaming/LayoutIn2.hs view

@@ -8,6 +8,5 @@ silly list = case list of  (1:xs) -> 1 --There is a comment                            (2:xs)-                             | x < 10    -> 4  where  x = last xs -                           otherwise -> 12 -+                             | x < 10    -> 4  where  x = last xs+                           otherwise -> 12

test/testdata/Renaming/LayoutIn2.hs.expected view

@@ -10,4 +10,3 @@                        (2:xs)                          | x < 10    -> 4  where  x = last xs                        otherwise -> 12-

+ test/testdata/RmOneParameter/A1.expected.hs view

@@ -0,0 +1,8 @@+module RmOneParameter.A1 where++import RmOneParameter.D1++sumSq xs ys= sum (map sq xs) + sumSquares xs++main = sumSq [1..4]+

+ test/testdata/RmOneParameter/A1.hs view

@@ -0,0 +1,8 @@+module RmOneParameter.A1 where+ +import RmOneParameter.D1++sumSq xs ys= sum (map sq xs) + sumSquares xs ys++main = sumSq [1..4]+

+ test/testdata/RmOneParameter/A2.expected.hs view

@@ -0,0 +1,8 @@+module RmOneParameter.A2 where++import RmOneParameter.D2++sumSq xs ys= sum (map sq xs) + sumSquares xs++main = sumSq [1..4]+

+ test/testdata/RmOneParameter/A2.hs view

@@ -0,0 +1,8 @@+module RmOneParameter.A2 where++import RmOneParameter.D2++sumSq xs ys= sum (map sq xs) + sumSquares xs ys++main = sumSq [1..4]+

+ test/testdata/RmOneParameter/D1.expected.hs view

@@ -0,0 +1,13 @@+module RmOneParameter.D1 where++{-remove parameter 'ys' from function 'sumSquares'. This refactoring+  affects module 'D1', and 'A1'-}++sumSquares (x:xs) = sq x + sumSquares xs++sumSquares [] = 0++sq x = x ^ pow++pow =2+

+ test/testdata/RmOneParameter/D1.hs view

@@ -0,0 +1,13 @@+module RmOneParameter.D1 where++{-remove parameter 'ys' from function 'sumSquares'. This refactoring+  affects module 'D1', and 'A1'-}++sumSquares (x:xs) ys = sq x + sumSquares xs xs++sumSquares [] ys = 0++sq x = x ^ pow++pow =2+

+ test/testdata/RmOneParameter/D2.expected.hs view

@@ -0,0 +1,14 @@+module RmOneParameter.D2 where++{-remove parameter 'ys' from function 'sumSquares'. This refactoring+  affects module 'D1', and 'A1'. This aims to test removing a+  parameter from a recursion function-}++sumSquares (x:xs) = sq x + sumSquares xs++sumSquares [] = 0++sq x = x ^ pow++pow =2+

+ test/testdata/RmOneParameter/D2.hs view

@@ -0,0 +1,14 @@+module RmOneParameter.D2 where++{-remove parameter 'ys' from function 'sumSquares'. This refactoring+  affects module 'D1', and 'A1'. This aims to test removing a+  parameter from a recursion function-}++sumSquares (x:xs) ys = sq x + sumSquares xs ys++sumSquares [] ys = 0++sq x = x ^ pow++pow =2+

+ test/testdata/RmOneParameter/FunIn0.expected.hs view

@@ -0,0 +1,13 @@+module FunIn0 where++--Any unused parameter to a definition can be removed.++--To select a formal parameter, just need to stop the cursor at any position between the start+--end position of this formal paramter.++--In this example, remove '[x,y]'++foo = h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = foo

+ test/testdata/RmOneParameter/FunIn0.hs view

@@ -0,0 +1,13 @@+module FunIn0 where++--Any unused parameter to a definition can be removed.++--To select a formal parameter, just need to stop the cursor at any position between the start+--end position of this formal paramter.++--In this example, remove '[x,y]'++foo [x,y]= h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = foo [4,5]

+ test/testdata/RmOneParameter/FunIn1.expected.hs view

@@ -0,0 +1,12 @@+module FunIn1 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++foo :: Int+foo = h + t where (h,t) = head $ zip [1..7] [3..15]++main :: Int+main = foo+

+ test/testdata/RmOneParameter/FunIn1.hs view

@@ -0,0 +1,12 @@+module FunIn1 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++foo :: Int -> Int+foo x= h + t where (h,t) = head $ zip [1..7] [3..15]++main :: Int+main = foo 4+

+ test/testdata/RmOneParameter/FunIn2.expected.hs view

@@ -0,0 +1,16 @@+module FunIn2 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++inc :: Int -> Int++foo :: Int+foo = h + t where (h,t) = head $ zip [1..7] [3..15]++inc x=x+1++main :: Int+main = foo+

+ test/testdata/RmOneParameter/FunIn2.hs view

@@ -0,0 +1,14 @@+module FunIn2 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++foo,inc :: Int -> Int+foo x= h + t where (h,t) = head $ zip [1..7] [3..15]++inc x=x+1++main :: Int+main = foo 4+

+ test/testdata/RmOneParameter/FunIn2a.expected.hs view

@@ -0,0 +1,16 @@+module FunIn2a where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++inc :: Int -> Int++foo :: Int+foo = h + t where (h,t) = head $ zip [1..7] [3..15]++inc x=x+1++main :: Int+main = foo+

+ test/testdata/RmOneParameter/FunIn2a.hs view

@@ -0,0 +1,14 @@+module FunIn2a where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' to 'foo'++inc,foo :: Int -> Int+foo x= h + t where (h,t) = head $ zip [1..7] [3..15]++inc x=x+1++main :: Int+main = foo 4+

+ test/testdata/RmOneParameter/FunIn3.expected.hs view

@@ -0,0 +1,11 @@+module FunIn3 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' (or 'z') to 'foo'++foo y  = h + t where (h,t) = head $ zip [1..7] [3..y]++main :: Int+main = foo 20+

+ test/testdata/RmOneParameter/FunIn3.hs view

@@ -0,0 +1,11 @@+module FunIn3 where++--Any unused parameter to a definition can be removed.++--In this example: remove the parameter 'x' (or 'z') to 'foo'++foo z@x y  = h + t where (h,t) = head $ zip [1..7] [3..y]++main :: Int+main = foo 10 20+

+ test/testdata/RmOneParameter/FunIn4.expected.hs view

@@ -0,0 +1,11 @@+module FunIn4 where++--Any unused parameter to a definition can be removed.++--In this example: remove 'x' will fail, as (x,y) is treated as one parameter and 'y' is used.++foo (x,y)  = h + t where (h,t) = head $ zip [1..7] [3..y]++main :: Int+main = foo (10, 20)+

+ test/testdata/RmOneParameter/FunIn4.hs view

@@ -0,0 +1,11 @@+module FunIn4 where++--Any unused parameter to a definition can be removed.++--In this example: remove 'x' will fail, as (x,y) is treated as one parameter and 'y' is used.++foo (x,y)  = h + t where (h,t) = head $ zip [1..7] [3..y]++main :: Int+main = foo (10, 20)+

+ test/testdata/RmOneParameter/FunIn5.expected.hs view

@@ -0,0 +1,13 @@+module FunIn5 where++--Any unused parameter to a definition can be removed.++--In this example: remove (x,y) (stop the cursor at 'x' or 'y')++foo = h + t where (h,t) = head $ zip [1..a] [3..b]+                  a=10+                  b=17++main :: Int+main = foo+

+ test/testdata/RmOneParameter/FunIn5.hs view

@@ -0,0 +1,13 @@+module FunIn5 where++--Any unused parameter to a definition can be removed.++--In this example: remove (x,y) (stop the cursor at 'x' or 'y')++foo (x,y)  = h + t where (h,t) = head $ zip [1..a] [3..b]+                         a=10+                         b=17++main :: Int+main = foo (10, 20)+

+ test/testdata/RmOneParameter/FunIn6.expected.hs view

@@ -0,0 +1,10 @@+module FunIn6 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++foo = h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = foo + foo

+ test/testdata/RmOneParameter/FunIn6.hs view

@@ -0,0 +1,10 @@+module FunIn6 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++foo x = h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = (foo 4) + (foo 5)

+ test/testdata/RmOneParameter/FunIn7.expected.hs view

@@ -0,0 +1,13 @@+module FunIn7 where++--Any unused parameter to a definition can be removed.++--To select a formal parameter, just need to stop the cursor at any position between the start+--end position of this formal paramter.++--In this example, remove '[x,y]' with a invalid cursor position++foo [x,y]= h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = foo [4,5]

+ test/testdata/RmOneParameter/FunIn7.hs view

@@ -0,0 +1,13 @@+module FunIn7 where++--Any unused parameter to a definition can be removed.++--To select a formal parameter, just need to stop the cursor at any position between the start+--end position of this formal paramter.++--In this example, remove '[x,y]' with a invalid cursor position++foo [x,y]= h + t where (h,t) = head $ zip [1..10] [3..10]++main :: Int+main = foo [4,5]

+ test/testdata/RmOneParameter/MultiFun1.expected.hs view

@@ -0,0 +1,11 @@+module MultiFun1 where++{-++Remove the second parameter from every equation for the function foo.++-}++foo [] = []+foo xs = [1]+

+ test/testdata/RmOneParameter/MultiFun1.hs view

@@ -0,0 +1,11 @@+module MultiFun1 where++{-++Remove the second parameter from every equation for the function foo.++-}++foo [] x = []+foo xs x = [1]+

+ test/testdata/RmOneParameter/SubFun1.expected.hs view

@@ -0,0 +1,10 @@+module SubFun1 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: Int+main = foo + foo+  where+    foo = h + t where (h,t) = head $ zip [1..10] [3..10]

+ test/testdata/RmOneParameter/SubFun1.hs view

@@ -0,0 +1,10 @@+module SubFun1 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: Int+main = (foo 4) + (foo 5)+  where+    foo x = h + t where (h,t) = head $ zip [1..10] [3..10]

+ test/testdata/RmOneParameter/SubFun2.expected.hs view

@@ -0,0 +1,12 @@+module SubFun2 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: Int+main =+  let+    foo = h + t where (h,t) = head $ zip [1..10] [3..10]+  in+    foo + foo

+ test/testdata/RmOneParameter/SubFun2.hs view

@@ -0,0 +1,12 @@+module SubFun2 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: Int+main =+  let+    foo x = h + t where (h,t) = head $ zip [1..10] [3..10]+  in+    (foo 4) + (foo 5)

+ test/testdata/RmOneParameter/SubFun3.expected.hs view

@@ -0,0 +1,11 @@+module SubFun3 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: IO Int+main = do+  let+    foo = h + t where (h,t) = head $ zip [1..10] [3..10]+  return $ foo + foo

+ test/testdata/RmOneParameter/SubFun3.hs view

@@ -0,0 +1,11 @@+module SubFun3 where++--Any unused parameter to a definition can be removed.++--In this example: remove x. The brackets enclosing 'foo' will also be removed.++main :: IO Int+main = do+  let+    foo x = h + t where (h,t) = head $ zip [1..10] [3..10]+  return $ (foo 4) + (foo 5)

test/testdata/cabal/foo/foo.cabal view

@@ -16,7 +16,7 @@ cabal-version:       >=1.10  Library-        Build-Depends:          base >= 4.0  && < 4.9+        Build-Depends:          base >= 4.0  && < 5         Hs-Source-Dirs:         src         Exposed-modules:                         Foo.Bar@@ -27,6 +27,6 @@   main-is:             Main.hs   -- other-modules:          -- other-extensions:    -  build-depends:       base >=4.8 && <4.9+  build-depends:       base >=4.8 && < 5   hs-source-dirs:      src   default-language:    Haskell2010

test/testdata/testdata.cabal view

@@ -8,80 +8,80 @@  Executable bcpp   Main-Is: BCpp.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable foo   Main-Is: TokenTest.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable dd2   Main-Is: DupDef/Dd2.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable dd3   Main-Is: DupDef/Dd3.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  Executable m   Main-Is: M.hs   Hs-Source-Dirs:       .-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable a1   Main-Is: Renaming/A1.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable a2   Main-Is: Renaming/A2.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable a3   Main-Is: Renaming/A3.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable a4   Main-Is: Renaming/A4.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable a5   Main-Is: Renaming/A5.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable c7   Main-Is: Renaming/C7.hs   Other-Modules : Renaming.D7-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable qualclient   Main-Is: Renaming/QualClient.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb   default-language:    Haskell2010  Executable th   Main-Is: TH/Main.hs-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5                         , syb                         , template-haskell   default-language:    Haskell2010@@ -93,7 +93,7 @@   Main-Is: LiftToToplevel/A1.hs   Other-Modules : LiftToToplevel.C1                   LiftToToplevel.D1-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  @@ -102,7 +102,7 @@   Main-Is: LiftToToplevel/A2.hs   Other-Modules : LiftToToplevel.C2                   LiftToToplevel.D2-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  -- ---------------------------------------------------------------------@@ -111,7 +111,7 @@   Main-Is: LiftOneLevel/A1.hs   Other-Modules : LiftOneLevel.C1                   LiftOneLevel.D1-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  @@ -119,7 +119,7 @@   Main-Is: LiftOneLevel/A2.hs   Other-Modules : LiftOneLevel.C2                   LiftOneLevel.D2-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  @@ -127,7 +127,7 @@   Main-Is: LiftOneLevel/A3.hs   Other-Modules : LiftOneLevel.C3                   LiftOneLevel.D3-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  -- ---------------------------------------------------------------------@@ -136,7 +136,7 @@   Main-Is: Demote/A1.hs   Other-Modules : Demote.C1                   Demote.D1-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  @@ -144,7 +144,7 @@   Main-Is: Demote/A2.hs   Other-Modules : Demote.C2                   Demote.D2-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010  -- ---------------------------------------------------------------------@@ -152,5 +152,45 @@ Executable qualified   Main-Is: TypeUtils/Qualified.hs   Other-Modules : TypeUtils.C-  Build-Depends:          base >= 4.0  && < 4.9+  Build-Depends:          base >= 4.0  && < 5   default-language:    Haskell2010++-- ---------------------------------------------------------------------++Executable addoneparama1+  Main-Is: AddOneParameter/A1.hs+  Other-Modules : AddOneParameter.C1+  Other-Modules : AddOneParameter.D1+  Build-Depends:          base >= 4.0  && < 5+  default-language:    Haskell2010++Executable addoneparama2+  Main-Is: AddOneParameter/A2.hs+  Other-Modules : AddOneParameter.C2+  Other-Modules : AddOneParameter.D2+  Build-Depends:          base >= 4.0  && < 5+  default-language:    Haskell2010++Executable addoneparama3+  Main-Is: AddOneParameter/A3.hs+  Other-Modules : AddOneParameter.D3+  Build-Depends:          base >= 4.0  && < 5+  default-language:    Haskell2010++-- ---------------------------------------------------------------------++Executable rmoneparama1+  Main-Is: RmOneParameter/A1.hs+  Other-Modules : RmOneParameter.D1+  Build-Depends:          base >= 4.0  && < 5+  default-language:    Haskell2010++-- ---------------------------------------------------------------------++Executable rmoneparama2+  Main-Is: RmOneParameter/A2.hs+  Other-Modules : RmOneParameter.D2+  Build-Depends:          base >= 4.0  && < 5+  default-language:    Haskell2010++-- ---------------------------------------------------------------------