HaRe 0.8.3.0 → 0.8.4.0

raw patch · 73 files changed

+3366/−1196 lines, 73 filesdep +attoparsecdep +base-preludedep +case-insensitivedep −QuickCheckdep −arraydep −deepseqdep ~Cabaldep ~HaRedep ~basesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: attoparsec, base-prelude, case-insensitive, conversion, conversion-case-insensitive, conversion-text, foldl, turtle

Dependencies removed: QuickCheck, array, deepseq, ghc-paths, ghc-prim, monoid-extras, old-time, pretty, process, rosezipper, semigroups, silently, stringbuilder, time, transformers, transformers-base

Dependency ranges changed: Cabal, HaRe, base, ghc-exactprint, ghc-mod, parsec

API changes (from Hackage documentation)

Files

• ChangeLog +7/−0
• HaRe.cabal +63/−89
• Setup.hs +0/−1
• app/MainHaRe.hs +362/−0
• src/Language/Haskell/Refact/API.hs +51/−5
• src/Language/Haskell/Refact/HaRe.hs +8/−1
• src/Language/Haskell/Refact/Refactoring/AddRmParam.hs +1/−1
• src/Language/Haskell/Refact/Refactoring/DeleteDef.hs +113/−0
• src/Language/Haskell/Refact/Refactoring/DupDef.hs +1/−1
• src/Language/Haskell/Refact/Refactoring/GenApplicative.hs +357/−0
• src/Language/Haskell/Refact/Refactoring/MoveDef.hs +21/−9
• src/Language/Haskell/Refact/Refactoring/Renaming.hs +336/−70
• src/Language/Haskell/Refact/Refactoring/Simple.hs +1/−1
• src/Language/Haskell/Refact/Utils/ExactPrint.hs +121/−4
• src/Language/Haskell/Refact/Utils/GhcModuleGraph.hs +2/−3
• src/Language/Haskell/Refact/Utils/GhcUtils.hs +12/−1
• src/Language/Haskell/Refact/Utils/LocUtils.hs +2/−3
• src/Language/Haskell/Refact/Utils/Monad.hs +14/−5
• src/Language/Haskell/Refact/Utils/MonadFunctions.hs +52/−18
• src/Language/Haskell/Refact/Utils/Query.hs +53/−0
• src/Language/Haskell/Refact/Utils/Synonyms.hs +15/−0
• src/Language/Haskell/Refact/Utils/Transform.hs +111/−0
• src/Language/Haskell/Refact/Utils/TypeSyn.hs +4/−2
• src/Language/Haskell/Refact/Utils/TypeUtils.hs +67/−59
• src/Language/Haskell/Refact/Utils/Types.hs +19/−2
• src/Language/Haskell/Refact/Utils/Utils.hs +221/−26
• src/Language/Haskell/Refact/Utils/Variables.hs +357/−125
• src/MainHaRe.hs +0/−312
• test/CaseSpec.hs +4/−8
• test/DeleteDefSpec.hs +41/−0
• test/Main.hs +93/−0
• test/MoveDefSpec.hs +130/−122
• test/RenamingSpec.hs +88/−6
• test/Spec.hs +0/−7
• test/SwapArgsSpec.hs +1/−1
• test/TestUtils.hs +2/−2
• test/TypeUtilsSpec.hs +341/−234
• test/UtilsSpec.hs +72/−15
• test/testdata/AddOneParameter/FunIn6.expected.hs +1/−1
• test/testdata/AddOneParameter/FunIn6.hs +1/−1
• test/testdata/AddParams2.hs +5/−0
• test/testdata/Demote/CaseIn1.hs +2/−4
• test/testdata/Demote/CaseIn1.hs.expected +0/−2
• test/testdata/Demote/D2.hs.expected +0/−12
• test/testdata/Demote/D2a.hs +13/−0
• test/testdata/Demote/D2a.hs.expected +12/−0
• test/testdata/Demote/LetIn1.hs +3/−5
• test/testdata/Demote/LetIn1.hs.expected +0/−2
• test/testdata/Demote/WhereIn7.hs +2/−3
• test/testdata/Demote/WhereIn7.hs.expected +0/−1
• test/testdata/FreeAndDeclared/Declare.hs +1/−1
• test/testdata/FreeAndDeclared/Declare2.hs +1/−1
• test/testdata/LiftToToplevel/PatBindIn2.hs +1/−1
• test/testdata/LiftToToplevel/PatBindIn4.hs +12/−0
• test/testdata/Renaming/Constructor.expected.hs +9/−0
• test/testdata/Renaming/Constructor.hs +9/−0
• test/testdata/Renaming/D1.hs +6/−6
• test/testdata/Renaming/D1.hs.expected +6/−6
• test/testdata/Renaming/ExportedType.expected.hs +4/−0
• test/testdata/Renaming/ExportedType.hs +4/−0
• test/testdata/Renaming/ExportedTypeClient.expected.hs +9/−0
• test/testdata/Renaming/ExportedTypeClient.hs +9/−0
• test/testdata/Renaming/Field1.hs +1/−1
• test/testdata/Renaming/Field1.hs.expected +1/−1
• test/testdata/Renaming/Field1_TokOut.hs +0/−10
• test/testdata/Renaming/Field4.hs +1/−1
• test/testdata/Renaming/IdIn5.hs +3/−0
• test/testdata/Renaming/InScopes.hs +21/−0
• test/testdata/Renaming/LayoutIn3.hs +1/−2
• test/testdata/Renaming/LayoutIn3.hs.expected +0/−1
• test/testdata/Renaming/WildCard.expected.hs +10/−0
• test/testdata/Renaming/WildCard.hs +10/−0
• test/testdata/testdata.cabal +65/−1

@@ -1,3 +1,10 @@+2017-02-11 v0.8.4.0+	* Update for GHC 8.0.2+	* Use ghc-mod version to 5.7+	* Add deleteDef refactoring to generalise a monadic function+	to use applicative (@SAdams601)+	* Add genapplicative refactoring to generalise a monadic function+	to use applicative (@SAdams601) 2016-08-03 v0.8.3.0 	* Update for GHC 8.0.1 	* Use ghc-mod version to 5.6 now it is released

@@ -1,6 +1,8 @@ Name:                           HaRe-Version:                        0.8.3.0-Author:                         Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman+Version:                        0.8.4.0++Author:                         Chris Brown, Huiqing Li, Simon Thompson,+                                Alan Zimmerman, Stephen Adams Maintainer:                     Alan Zimmerman (alan.zimm@gmail.com) Stability:                      Alpha Bug-Reports:                    http://github.com/RefactoringTools/HaRe/issues@@ -19,8 +21,10 @@    .    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)+   From version 0.8.4.0, GHC 8.0.2 is supported.    .+   It is tested against GHC 7.10.3, GHC 8.0.1 and GHC 8.0.2 (via travis-ci.org)+   .    It currently only has emacs integration built in, community input    welcome for others.    .@@ -42,7 +46,7 @@ Cabal-Version:                  >= 1.8 Build-Type:                     Simple -tested-with:                    GHC == 7.10.3, GHC == 8.0.1+tested-with:                    GHC == 7.10.3, GHC == 8.0.1, GHC == 8.0.2  data-files:                     elisp/*.el                                 configure.sh@@ -115,34 +119,33 @@ Library         -- GHC 7.10.2 ships with base 4.8.1.0         Build-Depends:          base >= 4.8.1.0  && < 5-                                , containers-                                , directory--                                , semigroups-                                , monoid-extras--                                , cabal-helper-                                , filepath-                                , ghc-                                , ghc-paths-                                , ghc-prim-                                , ghc-syb-utils-                                , ghc-mod >= 5.6.0.0-                                , mtl-                                , old-time-                                , pretty-                                , rosezipper-                                , syb-                                , hslogger-                                , transformers-                                , transformers-base-                                , time-                                , Strafunski-StrategyLib-                                , syz-                                , ghc-exactprint >= 0.5.2.1-                                , monad-control-                                , Cabal >= 1.22+                               , Strafunski-StrategyLib+                               , cabal-helper+                               , containers+                               , directory+                               , filepath+                               , ghc+                               , ghc-exactprint == 0.5.3.*+                               , ghc-mod == 5.7.0.*+                               , ghc-syb-utils+                               , hslogger+                               , monad-control+                               , mtl+                               , syb+                               , syz +        -- optimisation disabled otherwise the compile takes too long+        -- With normal optimisation, we get+        -- $ rm -fr dist-newstyle/+        -- $ cabal new-configure --enable-test+        -- $ time cabal new-build+        -- real	6m54.778s+        -- user	7m3.156s+        -- sys	0m4.504s+        -- With -O0, the timing is+        -- real	0m36.427s+        -- user 0m41.448s+        -- sys 0m2.544s         GHC-Options:            -O0         Hs-Source-Dirs:         src         -- Other-Modules:          Paths_HaRe@@ -157,6 +160,10 @@            , Language.Haskell.Refact.Refactoring.RoundTrip            , Language.Haskell.Refact.Refactoring.Simple            , Language.Haskell.Refact.Refactoring.SwapArgs+           , Language.Haskell.Refact.Refactoring.DeleteDef+--           , Language.Haskell.Refact.Refactoring.IntroduceTypeSyn+--           , Language.Haskell.Refact.Refactoring.UnwrapTypeSyn+           , Language.Haskell.Refact.Refactoring.GenApplicative            , Language.Haskell.Refact.Utils.ExactPrint            , Language.Haskell.Refact.Utils.GhcBugWorkArounds            , Language.Haskell.Refact.Utils.GhcModuleGraph@@ -170,6 +177,9 @@            , Language.Haskell.Refact.Utils.Types            , Language.Haskell.Refact.Utils.Utils            , Language.Haskell.Refact.Utils.Variables+           , Language.Haskell.Refact.Utils.Synonyms+           , Language.Haskell.Refact.Utils.Transform+           , Language.Haskell.Refact.Utils.Query            , Paths_HaRe         if impl (ghc < 7.10.2)             buildable: False@@ -181,44 +191,18 @@         GHC-Options:            -O0         -- GHC-Options:            -prof -fprof-auto -rtsopts -caf-all         Hs-Source-Dirs:-          ./src+          ./app          -- GHC 7.10.2 ships with base 4.8.1.0         Build-Depends:          base >= 4.8.1.0  && < 5-                                , array-                                , containers-                                , directory--                                , semigroups-                                , monoid-extras--                                , cabal-helper-                                , filepath-                                , ghc-                                , ghc-paths-                                , ghc-prim-                                , ghc-syb-utils+                                , ghc-mod                                 , gitrev >= 1.1-                                , ghc-mod >= 5.6.0.0                                 , mtl                                 , optparse-applicative                                 , optparse-simple-                                , old-time-                                , parsec >= 3.1.6-                                , pretty-                                , rosezipper-                                , syb-                                , time-                                , transformers-                                , transformers-base-                                , hslogger-                                , Strafunski-StrategyLib-                                , syz-                                , ghc-exactprint >= 0.5.2.1-                                , monad-control-                                , Cabal >= 1.22+                                , Cabal                                 -- , Paths_HaRe-                                , HaRe >= 0.8.2.1+                                , HaRe         Extensions:      CPP         if impl (ghc < 7.10.2)             buildable: False@@ -236,9 +220,9 @@   cpp-options:       -DTEST   main-is:-      Spec.hs+      Main.hs   Hs-Source-Dirs:-    src+    -- src     test   other-modules:       AddRmParamSpec@@ -255,6 +239,9 @@     , TestUtils     , TypeUtilsSpec     , UtilsSpec+    , DeleteDefSpec+--    , IntroduceTypeSynSpec+--    , UnwrapTypeSynSpec      -- , Language.Haskell.Refact.API     -- , Language.Haskell.Refact.HaRe@@ -279,39 +266,26 @@       base        >= 4.8.1.0  && < 5     , Diff >= 0.3.0     , HUnit-    , QuickCheck  >= 2.5     , containers--    , cabal-helper-    , semigroups-    , monoid-extras--    , deepseq     , directory-    , filepath+    , foldl     , ghc-    , ghc-paths-    , ghc-prim+    , ghc-exactprint == 0.5.3.*+    , ghc-mod == 5.7.0.*     , ghc-syb-utils-    , ghc-mod >= 5.6.0.0+    , hslogger     , hspec     , mtl-    , old-time-    , process-    , silently-    , stringbuilder-    , rosezipper-    , syb-    , transformers-    , transformers-base-    , time-    , hslogger-    , Strafunski-StrategyLib-    , syz-    , ghc-exactprint >= 0.5.2.1-    , monad-control-    , Cabal >= 1.22+    , turtle >= 1.3.0+    , foldl     -- , Paths_HaRe+    , attoparsec+    , base-prelude+    , conversion-case-insensitive+    , conversion+    , conversion-text+    , parsec+    , case-insensitive     , HaRe >= 0.8.2.1   Extensions:      CPP   if impl (ghc < 7.10.2)

@@ -1,3 +1,2 @@ import Distribution.Simple main = defaultMain-

@@ -0,0 +1,362 @@+{-# 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++-- temporary until exposed by ghc-mod+-- import           Options+import           Language.Haskell.GhcMod.Options.Options++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++              addCommand "dupdef"+                         "Duplicate a definition"+                         runCmd+                         dupDefCmdOpts++              addCommand "iftocase"+                         "Convert an if statement to a case statement"+                         runCmd+                         ifToCaseCmdOpts++              addCommand "liftOneLevel"+                         "Lift a definition up one level"+                         runCmd+                         liftOneLevelCmdOpts++              addCommand "liftToTopLevel"+                         "Lift a definition to the top level"+                         runCmd+                         liftToTopLevelCmdOpts++              addCommand "rename"+                         "Rename an identifier"+                         runCmd+                         renameCmdOpts++              addCommand "addOneParam"+                         "Add a new parameter to a function in first position"+                         runCmd+                         addOneParamCmdOpts++              addCommand "rmOneParam"+                         "Remove a new parameter from a function"+                         runCmd+                         rmOneParamCmdOpts++              addCommand "genApplicative"+                         "Generalise a monadic function to use applicative"+                         runCmd+                         genApplicativeOpts++              addCommand "deleteDef"+                         "Delete a definition"+                         runCmd+                         deleteDefOpts+    run global++-- ---------------------------------------------------------------------++type Row = Int+type Col = Int++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+                | GenApplicative FilePath String Row Col+                | DeleteDef      FilePath Row Col+               deriving Show++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)++runCmd (IfToCaseCmd fileName sr sc er ec) (opt, gOpt)+  = runFunc $ ifToCase opt gOpt fileName (sr,sc) (er,ec)++runCmd (LiftOneLevel fileName r c) (opt, gOpt)+  = runFunc $ liftOneLevel opt gOpt fileName (r,c)++runCmd (LiftToTopLevel fileName r c) (opt, gOpt)+  = runFunc $ liftToTopLevel opt gOpt fileName (r,c)++runCmd (RenameCmd fileName newname r c) (opt, gOpt)+  = runFunc $ rename opt gOpt fileName newname (r,c)++runCmd (AddOneParam fileName newname r c) (opt, gOpt)+  = runFunc $ addOneParameter opt gOpt fileName newname (r,c)++runCmd (RmOneParam fileName r c) (opt, gOpt)+  = runFunc $ rmOneParameter opt gOpt fileName (r,c)++runCmd (GenApplicative fileName funNm r c) (opt, gOpt)+  = runFunc $ genApplicative opt gOpt fileName funNm (r,c)++runCmd (DeleteDef fileName r c) (opt, gOpt)+  = runFunc $ deleteDef opt gOpt fileName (r,c)++rmOneParamCmdOpts :: Parser HareParams+rmOneParamCmdOpts =+    RmOneParam+      <$> 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")++-- ---------------------------------------------------------------------++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")++-- ---------------------------------------------------------------------++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 =+    LiftToTopLevel+      <$> 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")++genApplicativeOpts :: Parser HareParams+genApplicativeOpts =+  GenApplicative+     <$> strArgument+          ( metavar "FILE"+         <> help "Specify Haskell file to process"+          )+      <*> strArgument+            ( metavar "FUNNAME"+           <> help "The name of the function to be refactored"+            )+      <*> argument auto+            ( metavar "line"+           <> help "The line the definition is on")+      <*> argument auto+            ( metavar "col"+           <> help "A col inside the definition name")++-- ---------------------------------------------------------------------++deleteDefOpts :: Parser HareParams+deleteDefOpts =+    DeleteDef+      <$> 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")++++-- ---------------------------------------------------------------------++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+  let ret = case r of+       Left s    -> "(error " ++ (show s) ++ ")"+       Right mfs -> "(ok " ++ showLisp mfs ++ ")"+  putStrLn ret++showLisp :: [String] -> String+showLisp xs = "(" ++ (intercalate " " $ map (\str -> "\"" ++ unixSlashes str ++ "\"") xs) ++ ")"+  where unixSlashes = map (\c -> if c == '\\' then '/' else c)++catchException :: (IO t) -> IO (Either String t)+catchException f = do+  res <- handle handler (f >>= \r -> return $ Right r)+  return res+  where+    handler:: SomeException -> IO (Either String t)+    handler e = return (Left (stripCallStack $ show e))

@@ -22,7 +22,6 @@        , logDataWithAnns        , logExactprint        , logParsedSource-  -- * from `Language.Haskell.Refact.Utils.Utils`         -- ** Managing the GHC / project environment@@ -31,7 +30,9 @@         -- ** The bits that do the work        , runRefacSession+       , runMultRefacSession        , applyRefac+       , applyRefac'        , refactDone        , ApplyRefacResult        , RefacSource(..)@@ -41,6 +42,7 @@        , getModuleName        , clientModsAndFiles        , serverModsAndFiles+       -- , lookupAnns         , stripCallStack @@ -78,6 +80,7 @@         , setStateStorage        , getStateStorage+       , fetchAnnsFinal         -- * Parsing source        , parseDeclWithAnns@@ -95,8 +98,10 @@                      , getLocatedEnd                      , getStartEndLoc                      , startEndLocGhc-                     , emptyList, nonEmptyList+                     , emptyList+                     , nonEmptyList +  -- * from `Language.Haskell.Refact.Utils.TypeSyn`     , InScopes     , ghead@@ -130,6 +135,8 @@     , hsFDsFromInsideRdr, hsFDNamesFromInsideRdr, hsFDNamesFromInsideRdrPure     , hsVisibleDsRdr     , rdrName2Name, rdrName2NamePure+    , eqRdrNamePure+    , sameNameSpace      -- *** Property checking     ,isVarId,isConId,isOperator,isTopLevelPN,isLocalPN,isNonLibraryName -- ,isTopLevelPNT@@ -153,7 +160,7 @@     -- *** Locations     ,defineLoc, useLoc, locToExp     ,findLRdrName-    -- ,locToName+    ,locToNameRdr     ,locToNameRdrPure     ,locToRdrName     ,getName@@ -198,6 +205,7 @@     , everywhereStaged     , everywhereStaged'     , listifyStaged+    , everywhereButM      -- ** Scrap Your Zipper versions     , zeverywhereStaged@@ -225,11 +233,48 @@  -- * from `Language.Haskell.Refact.Utils.ExactPrint'`   , replace   , setRefactAnns+  , mergeRefactAnns   , setAnnKeywordDP   , copyAnn   , clearPriorComments   , balanceAllComments +  , exactPrintParsed+  , exactPrintExpr+  , zeroDP+  , setDP+  , handleParseResult+  , removeAnns+  , synthesizeAnns+  , addNewKeyword+  , addNewKeywords++  , addEmptyAnn+  , addAnnVal+  , addAnn++   -- from Language.Haskell.Refact.Utils.Synonyms+ , UnlocParsedHsBind+ , ParsedGRHSs+ , ParsedMatchGroup+ , ParsedLMatch+ , ParsedExpr+ , ParsedLStmt+ , ParsedLExpr+ , ParsedBind++ -- from Language.Haskell.Refact.Utils.Transform+  , addSimpleImportDecl+  , wrapInLambda+  , wrapInPars+  , removePars+  , addNewLines+  , wrapInParsWithDPs+  , locate+-- from Language.Haskell.Refact.Utils.Query+  , getVarAndRHS+  , getHsBind+  , isHsVar  ) where  import Language.Haskell.Refact.Utils.ExactPrint@@ -243,6 +288,7 @@ import Language.Haskell.Refact.Utils.Types import Language.Haskell.Refact.Utils.Utils import Language.Haskell.Refact.Utils.Variables-+import Language.Haskell.Refact.Utils.Transform import Language.Haskell.GHC.ExactPrint.Utils-+import Language.Haskell.Refact.Utils.Synonyms+import Language.Haskell.Refact.Utils.Query

@@ -19,9 +19,12 @@  , rename,          compRename  , addOneParameter, compAddOneParameter  , rmOneParameter,  compRmOneParameter+ , deleteDef,       compDeleteDef  -- , swapArgs  , roundTrip-+-- , introduceTypeSyn+-- , unwrapTypeSyn+ , genApplicative, compGenApplicative  ) where @@ -30,6 +33,10 @@ import Language.Haskell.Refact.Refactoring.DupDef import Language.Haskell.Refact.Refactoring.MoveDef import Language.Haskell.Refact.Refactoring.Renaming+--import Language.Haskell.Refact.Refactoring.IntroduceTypeSyn+import Language.Haskell.Refact.Refactoring.DeleteDef+--import Language.Haskell.Refact.Refactoring.UnwrapTypeSyn+import Language.Haskell.Refact.Refactoring.GenApplicative -- import Language.Haskell.Refact.Refactoring.SwapArgs import Language.Haskell.Refact.Refactoring.RoundTrip import Language.Haskell.Refact.Utils.Monad

@@ -365,7 +365,7 @@ #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))]+  liftT $ addSimpleAnnT lname (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))]

@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Haskell.Refact.Refactoring.DeleteDef+  (deleteDef, compDeleteDef) where++import qualified Data.Generics as SYB+import qualified GHC.SYB.Utils as SYB+import BasicTypes+import qualified GHC+import Control.Monad+import Control.Monad.State+import Language.Haskell.GhcMod+import Language.Haskell.Refact.API+import Data.Generics.Strafunski.StrategyLib.StrategyLib+import qualified Language.Haskell.GhcMod as GM+import qualified Language.Haskell.GhcMod.Internal as GM+import System.Directory+import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Types++deleteDef :: RefactSettings -> GM.Options -> FilePath -> SimpPos -> IO [FilePath]+deleteDef settings cradle fileName (row,col) = do+  absFileName <- canonicalizePath fileName+  runRefacSession settings cradle (compDeleteDef absFileName (row,col))++compDeleteDef ::FilePath -> SimpPos -> RefactGhc [ApplyRefacResult]+compDeleteDef fileName (row,col) = do+  parseSourceFileGhc fileName+  renamed <- getRefactRenamed+  parsed <- getRefactParsed+  targetModule <- getRefactTargetModule+  m <- getModule+  let (Just (modName,_)) = getModuleName parsed+      maybeRdrPn = locToRdrName (row,col) parsed+  case maybeRdrPn of+    Just pn@(GHC.L _ n) ->+      do+        logm $ "DeleteDef.comp: before isPNUsed"+        Just ghcn <- locToNameRdr (row,col) parsed+        pnIsUsedLocal <- isPNUsed ghcn targetModule fileName+        clients <- clientModsAndFiles targetModule+        pnUsedClients <- isPNUsedInClients ghcn n targetModule+        if (pnIsUsedLocal || pnUsedClients)+           then error "The def to be deleted is still being used"+          else do+          logm $ "Result of is used: " ++ (show pnIsUsedLocal) ++ " pnUsedClients: " ++ (show pnUsedClients)+          (refRes@((_fp,ismod), (anns,ps)),()) <- applyRefac (doDeletion ghcn) RSAlreadyLoaded+          case (ismod) of+            RefacUnmodifed -> do+              error "The def deletion failed"+            RefacModified -> return ()+          logm $ "Res after delete === " ++ (exactPrint ps anns)+          return [refRes]+    Nothing -> error "Invalid cursor position!"+++isPNUsed :: GHC.Name -> GM.ModulePath -> FilePath -> RefactGhc Bool+isPNUsed pn modPath filePath = do+  renamed <- getRefactRenamed+  pnUsedInScope pn renamed+++pnUsedInScope :: (SYB.Data t) => GHC.Name -> t -> RefactGhc Bool+pnUsedInScope pn t' = do+  logm $ "Start of pnUsedInScope"+  res <- applyTU (stop_tdTU (failTU `adhocTU` bind `adhocTU` var)) t'+  return $ (length res) > 0+    where+#if __GLASGOW_HASKELL__ <= 710+      bind ((GHC.FunBind (GHC.L l name) _ match _ _ _) :: GHC.HsBindLR GHC.Name GHC.Name)+#else+      bind ((GHC.FunBind (GHC.L l name)  match _ _ _) :: GHC.HsBindLR GHC.Name GHC.Name)+#endif+        | name == pn = do+            logm $ "Found Binding at: " ++ (showGhc l)+            return []+      bind other = do+        mzero+#if __GLASGOW_HASKELL__ <= 710+      var ((GHC.HsVar name) :: GHC.HsExpr GHC.Name)+#else+      var ((GHC.HsVar (GHC.L _ name)) :: GHC.HsExpr GHC.Name)+#endif+        | name == pn = do+            logm $ "Found var"+            return [pn]+      var other = do+        mzero+++isPNUsedInClients :: GHC.Name -> GHC.RdrName -> GM.ModulePath -> RefactGhc Bool+isPNUsedInClients pn rdrn modPath = do+        pnIsExported <- isExported pn+        if pnIsExported+          then do clients <- clientModsAndFiles modPath+                  logm $ "DeleteDef : clients: " ++ (showGhc clients)+                  res <- foldM (pnUsedInClientScope pn) False clients+                  return res+          else do return False++pnUsedInClientScope :: GHC.Name -> Bool -> TargetModule -> RefactGhc Bool+pnUsedInClientScope name b mod = do+  getTargetGhc mod+  isInScope <- isInScopeAndUnqualifiedGhc (nameToString name) Nothing+  logm $ "The module file path: " ++ (show (GM.mpPath mod)) ++ "\n is pn in scope: " ++ (show isInScope)+  return (b || isInScope)++doDeletion :: GHC.Name -> RefactGhc ()+doDeletion n = do+  parsed <- getRefactParsed+  (res, _decl, _mSig) <- rmDecl n True parsed+  putRefactParsed res emptyAnns+  return ()

@@ -159,7 +159,7 @@           = filter (\d->isFunBindP d || isSimplePatDecl d) $ definingDeclsRdrNames nm [n] ds True False  -        doDuplicating' :: (SYB.Typeable t,SYB.Data t) => GHC.Name -> t -> GHC.Located GHC.Name -> RefactGhc t+        doDuplicating' :: (SYB.Data t) => GHC.Name -> t -> GHC.Located GHC.Name -> RefactGhc t         doDuplicating' newNameGhc t _ln = do           logm $ "doDuplicating' entered"           -- logm $ "doDuplicating' entered:t=" ++ SYB.showData SYB.Parser 0 t

@@ -0,0 +1,357 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+module Language.Haskell.Refact.Refactoring.GenApplicative+  (genApplicative, compGenApplicative) where++import Language.Haskell.Refact.API+import qualified Language.Haskell.GhcMod as GM+import qualified GHC as GHC+import qualified RdrName as GHC+import System.Directory+import FastString+import Data.Map as Map (union)+import Data.Generics as SYB+import GHC.SYB.Utils as SYB+import Data.List+import Control.Monad+import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Types+import Language.Haskell.GHC.ExactPrint.Print+import Language.Haskell.GHC.ExactPrint.Parsers++genApplicative :: RefactSettings -> GM.Options -> FilePath -> String -> SimpPos -> IO [FilePath]+genApplicative settings cradle fileName funNm pos = do+  absFileName <- canonicalizePath fileName+  runRefacSession settings cradle (compGenApplicative absFileName funNm pos)++compGenApplicative :: FilePath -> String -> SimpPos -> RefactGhc [ApplyRefacResult]+compGenApplicative fileName funNm pos = do+  (refRes@((_fp,ismod),_), ()) <- applyRefac (doGenApplicative fileName funNm pos) (RSFile fileName)+  case ismod of+    RefacUnmodifed -> error "Generalise to Applicative failed"+    RefacModified -> return ()+  return [refRes]++--The general operation of this refactoring involves transposing the LHsExpr's from within the list of ExprLStmt's+-- to an (OpApp :: HsExpr)+-- The function begins by constructing the beginning of the applicative chain by looking at the construction of the return statement++doGenApplicative :: FilePath -> String -> SimpPos -> RefactGhc ()+doGenApplicative fileName funNm pos = do+  parsed <- getRefactParsed+  let Just funBind = getHsBind pos funNm parsed+      (Just retRhs) = getReturnRhs funBind+      (Just doStmts) = getDoStmts funBind+      boundVars = findBoundVars doStmts+  checkPreconditions retRhs doStmts boundVars+  appChain <- constructAppChain retRhs doStmts+  replaceFunRhs funNm pos appChain+++checkPreconditions :: ParsedExpr -> [GHC.ExprLStmt GHC.RdrName] -> [GHC.RdrName] -> RefactGhc ()+checkPreconditions retRhs doStmts boundVars = do+  let boundVarsPrecon = checkBVars doStmts boundVars+      retVarsOrder = varOrdering boundVars retRhs+      orderingPrecon = checkOrdering retVarsOrder doStmts+  if (not boundVarsPrecon)+    then error "GenApplicative Precondition: The function given uses a bound variable in a RHS expression."+    else if (not orderingPrecon)+         then error "GenApplicative Precondition: Variables are not bound in the order that they appear in the return statement."+         else return ()+  where checkBVars [] _ = True+        checkBVars (stmt:stmts) vars = case stmt of+          (GHC.L _ (GHC.BodyStmt body _ _ _)) -> (not (lexprContainsVars vars body)) && (checkBVars stmts vars)+#if __GLASGOW_HASKELL__ <= 710+          (GHC.L _ (GHC.BindStmt _ body _ _)) -> (not (lexprContainsVars vars body)) && (checkBVars stmts vars)+#else+          (GHC.L _ (GHC.BindStmt _ body _ _ _)) -> (not (lexprContainsVars vars body)) && (checkBVars stmts vars)+#endif+        lexprContainsVars :: [GHC.RdrName] -> ParsedLExpr -> Bool+        lexprContainsVars vars = SYB.everything (||) (False `SYB.mkQ` (\nm -> elem nm vars))+        varOrdering :: [GHC.RdrName] -> ParsedExpr -> [GHC.RdrName]+        varOrdering boundVars = SYB.everything (++) ([] `SYB.mkQ` (\nm -> if (elem nm boundVars) then [nm] else []))+        checkOrdering :: [GHC.RdrName] -> [GHC.ExprLStmt GHC.RdrName] -> Bool+        checkOrdering [] [] = True+        checkOrdering [] ((GHC.L _ (GHC.BodyStmt _ _ _ _)):stmts) = checkOrdering [] stmts+        checkOrdering vars ((GHC.L _ (GHC.BodyStmt _ _ _ _)):stmts) = checkOrdering vars stmts+#if __GLASGOW_HASKELL__ <= 710+        checkOrdering (var:vars) ((GHC.L _ (GHC.BindStmt pat _ _ _)):stmts) =+#else+        checkOrdering (var:vars) ((GHC.L _ (GHC.BindStmt pat _ _ _ _)):stmts) =+#endif+          if (checkPat var pat)+          then (checkOrdering vars stmts)+          else False+        checkPat var pat = gContains var pat++gContains :: (Data t, Eq a, Data a) => a -> t -> Bool+gContains item t = SYB.everything (||) (False `SYB.mkQ` (\b -> item == b)) t++replaceFunRhs :: String -> SimpPos -> ParsedLExpr -> RefactGhc ()+replaceFunRhs funNm pos newRhs = do+  parsed <- getRefactParsed+  let rdrNm = locToRdrName pos parsed+  case rdrNm of+    Nothing -> error "replaceFunRhs: Position does not correspond to a binding."+    (Just (GHC.L _ rNm)) -> do+      newParsed <- everywhereMStaged SYB.Parser (SYB.mkM (worker rNm)) parsed+      putRefactParsed newParsed emptyAnns+      logParsedSource "GenApplicative.replaceFunRhs"+  where worker :: GHC.RdrName -> ParsedBind -> RefactGhc (GHC.HsBind GHC.RdrName)+#if __GLASGOW_HASKELL__ <= 710+        worker rNm fBind@(GHC.FunBind (GHC.L _ fNm) _ mg _ _ _)+#else+        worker rNm fBind@(GHC.FunBind (GHC.L _ fNm) mg _ _ _)+#endif+          | fNm == rNm = do+              newMg <- replaceMG mg+              return $ fBind{GHC.fun_matches = newMg}+          | otherwise = return fBind+        worker _ bind = return bind+        replaceMG :: ParsedMatchGroup -> RefactGhc ParsedMatchGroup+        replaceMG mg = do+#if __GLASGOW_HASKELL__ <= 710+          let [(GHC.L l match)] = GHC.mg_alts mg+#else+          let (GHC.L _ [(GHC.L l match)]) = GHC.mg_alts mg+#endif+              oldGrhss = GHC.m_grhss match+              newGrhss = mkGrhss oldGrhss newRhs+              newLMatch = (GHC.L l (match{GHC.m_grhss = newGrhss}))+#if __GLASGOW_HASKELL__ <= 710+          return mg{GHC.mg_alts = [newLMatch]}+#else+          lMatchLst <- locate [newLMatch]+          return mg{GHC.mg_alts = lMatchLst}+#endif+        mkGrhss old newExpr = let [(GHC.L l (GHC.GRHS lst _))] = GHC.grhssGRHSs old in+          old{GHC.grhssGRHSs = [(GHC.L l (GHC.GRHS lst newExpr))]}++++processReturnStatement :: ParsedExpr -> [GHC.RdrName] -> RefactGhc (Maybe ParsedLExpr)+processReturnStatement retExpr boundVars+  | isJustBoundVar retExpr boundVars = return Nothing+  | otherwise =+      case retExpr of+        (GHC.ExplicitTuple lst _) -> do+          dFlags <- GHC.getSessionDynFlags+          let commas = repeat ','+              constr = "(" ++ (take ((length lst)-1) commas) ++ ")"+              parseRes = parseExpr dFlags "hare" constr+          case parseRes of+            (Left (_, errMsg)) -> do+              logm "processReturnStatement: error parsing tuple constructor"+              return Nothing+            (Right (anns, expr)) -> do+              mergeRefactAnns anns+              return (Just expr)+        _ -> do+          lRet <- locate retExpr+          stripBoundVars lRet boundVars+      where stripBoundVars :: ParsedLExpr -> [GHC.RdrName] -> RefactGhc (Maybe ParsedLExpr)+#if __GLASGOW_HASKELL__ <= 710+            stripBoundVars le@(GHC.L l (GHC.HsVar nm)) names =+#else+            stripBoundVars le@(GHC.L l (GHC.HsVar (GHC.L _ nm))) names =+#endif+              if (elem nm names)+              then return Nothing+              else return (Just le)+            stripBoundVars (GHC.L l (GHC.HsApp expr1 expr2)) names = do+              ne1 <- stripBoundVars expr1 names+              ne2 <- stripBoundVars expr2 names+              case ne2 of+                Nothing -> return ne1+                (Just e2) -> return (ne1 >>= (\e1 -> Just (GHC.L l (GHC.HsApp e1 e2))))++isJustBoundVar :: ParsedExpr -> [GHC.RdrName] -> Bool+#if __GLASGOW_HASKELL__ <= 710+isJustBoundVar (GHC.HsVar nm) names = elem nm names+#else+isJustBoundVar (GHC.HsVar (GHC.L _ nm)) names = elem nm names+#endif+isJustBoundVar _ _ = False++getDoStmts :: GHC.HsBind GHC.RdrName -> Maybe [GHC.ExprLStmt GHC.RdrName]+getDoStmts funBind = SYB.something (Nothing `SYB.mkQ` stmtLst) funBind+  where stmtLst :: GHC.HsExpr GHC.RdrName -> Maybe [GHC.ExprLStmt GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+        stmtLst (GHC.HsDo _ stmtLst _) = Just (init stmtLst)+#else+        stmtLst (GHC.HsDo _ (GHC.L _ stmtLst) _) = Just (init stmtLst)+#endif+        stmtLst _ = Nothing++findBoundVars :: [GHC.ExprLStmt GHC.RdrName] -> [GHC.RdrName]+findBoundVars = SYB.everything (++) ([] `SYB.mkQ` findVarPats)+  where findVarPats :: GHC.Pat GHC.RdrName -> [GHC.RdrName]+#if __GLASGOW_HASKELL__ <= 710+        findVarPats (GHC.VarPat rdr) = [rdr]+#else+        findVarPats (GHC.VarPat (GHC.L _ rdr)) = [rdr]+#endif+        findVarPats _ = []++getReturnRhs :: UnlocParsedHsBind -> Maybe ParsedExpr+getReturnRhs funBind = SYB.something (Nothing `SYB.mkQ` retStmt `SYB.extQ` dollarRet) funBind+  where retStmt :: GHC.ExprLStmt GHC.RdrName -> Maybe ParsedExpr+        retStmt (GHC.L _ (GHC.BodyStmt (GHC.L _ body)  _ _ _)) = if isRet body+          then Just (retRHS body)+          else Nothing+        retStmt _ = Nothing+        dollarRet :: ParsedExpr -> Maybe ParsedExpr+        dollarRet (GHC.OpApp ret dollar _ expr) = if (isHsVar "return" $ GHC.unLoc ret) && (isHsVar "$" $ GHC.unLoc dollar)+          then Just (GHC.unLoc expr)+          else Nothing+        dollarRet _ = Nothing+        isRet :: ParsedExpr -> Bool+        isRet (GHC.HsApp (GHC.L _ mRet) _) = isHsVar "return" mRet+        isRet _ = False+        retRHS :: ParsedExpr -> ParsedExpr+        retRHS (GHC.HsApp _  (GHC.L _ rhs)) = rhs++constructAppChain :: ParsedExpr -> [GHC.ExprLStmt GHC.RdrName] -> RefactGhc ParsedLExpr+constructAppChain retRhs lst = do+  let clusters = clusterStmts lst+      boundVars = findBoundVars lst+  pars <- mapM buildSingleExpr clusters+  pars2 <- if length pars == 1+              then do newP <- (removePars (head pars))+                      return [newP]+              else return pars+  effects <- buildChain pars2+  mPure <- processReturnStatement retRhs boundVars+  case mPure of+    Nothing -> do+      return effects+    (Just pure) -> do+      setDP (DP (0,1)) pure+      lOp <- lInfixFmap+      addAnnVal lOp+      locate (GHC.OpApp pure lOp GHC.PlaceHolder effects)+  where+    buildChain :: [ParsedLExpr] -> RefactGhc ParsedLExpr+    buildChain [e] = return e+    buildChain (e:es) = do+      rhs <- buildChain es+      lOp <- lFApp+      addAnnVal lOp+      let opApp = (GHC.OpApp e lOp GHC.PlaceHolder rhs)+      locate opApp+    getStmtExpr :: GHC.ExprLStmt GHC.RdrName -> ParsedLExpr+    getStmtExpr (GHC.L _ (GHC.BodyStmt body _ _ _)) = body+#if __GLASGOW_HASKELL__ <= 710+    getStmtExpr (GHC.L _ (GHC.BindStmt _ body _ _)) = body+#else+    getStmtExpr (GHC.L _ (GHC.BindStmt _ body _ _ _)) = body+#endif+    buildSingleExpr :: [GHC.ExprLStmt GHC.RdrName] -> RefactGhc ParsedLExpr+    buildSingleExpr [st] = return $ getStmtExpr st+    buildSingleExpr lst@(st:stmts) = do+      let (before,(bindSt:after)) = break isBindStmt lst+      rOp <- rApp+      lOp <- lApp+      mLeftOfBnds <- buildApps rOp (map getStmtExpr before)+      mRightOfBnds <- buildApps lOp (map getStmtExpr after)+      mapM_ (\ex -> (setDP (DP (0,1))) (getStmtExpr ex)) (tail lst)+      lROp <- lRApp+      addAnnVal lROp+      lLOp <- lLApp+      addAnnVal lLOp+      newBndStmt <- mkBind (getStmtExpr bindSt)+      case (mLeftOfBnds,mRightOfBnds) of+        (Nothing,Nothing) -> error "buildSingleExpr was passed an empty list."+        ((Just leftOfBnds),Nothing) -> do+          app <- locate (GHC.OpApp leftOfBnds lROp GHC.PlaceHolder newBndStmt)+          wrapInPars app+        (Nothing, (Just rightOfBnds)) -> do+          app <- locate (GHC.OpApp newBndStmt lLOp GHC.PlaceHolder rightOfBnds)+          wrapInPars app+        ((Just leftOfBnds),(Just rightOfBnds)) -> do+          setDP (DP (0,1)) newBndStmt+          lOpApp <- locate (GHC.OpApp leftOfBnds lROp GHC.PlaceHolder newBndStmt)+          fullApp <- locate (GHC.OpApp lOpApp lLOp GHC.PlaceHolder rightOfBnds)+          wrapInPars fullApp+    mkBind :: ParsedLExpr -> RefactGhc ParsedLExpr+    mkBind e@(GHC.L _ (GHC.HsVar _)) = return e+    mkBind expr = do+      zeroDP expr+      wrapInParsWithDPs (DP (0,0)) (DP (0,0)) expr+    buildApps :: ParsedExpr -> [ParsedLExpr] -> RefactGhc (Maybe ParsedLExpr)+    buildApps op [] = return Nothing+    buildApps op [st] = return (Just st)+    buildApps op (st:stmts) = do+      mRhs <- buildApps op stmts+      case mRhs of+        Nothing -> return (Just st)+        (Just rhs) -> do+          lOp <- locate op+          addAnnVal lOp+          lExpr <- locate (GHC.OpApp st lOp GHC.PlaceHolder rhs)+          return (Just lExpr)+    clusterStmts :: [GHC.ExprLStmt GHC.RdrName] -> [[GHC.ExprLStmt GHC.RdrName]]+    clusterStmts lst = let indices = findIndices isBindStmt lst+                           clusters = cluster indices (length lst) 0 in+                       map (\is -> map (\i -> lst !! i) is) clusters+    cluster [i] l c = [[c..(l-1)]]+    cluster (i1:i2:is) l c = let b = i1 + ((i2-i1) `div` 2) in+      [c .. b]:(cluster (i2:is) l (b+1))++--Checks if a name occurs in the given ast chunk+nameOccurs :: Data a => GHC.RdrName -> a -> Bool+nameOccurs nm = SYB.everything (||) (False `SYB.mkQ` isName)+  where isName :: GHC.RdrName -> Bool+        isName mName = nm == mName++isBindStmt :: GHC.ExprLStmt GHC.RdrName -> Bool+#if __GLASGOW_HASKELL__ <= 710+isBindStmt (GHC.L _ (GHC.BindStmt _ _ _ _)) = True+#else+isBindStmt (GHC.L _ (GHC.BindStmt _ _ _ _ _)) = True+#endif+isBindStmt _ = False++lFApp :: RefactGhc ParsedLExpr+lFApp = fApp >>= locate++fApp :: RefactGhc ParsedExpr+fApp = hsVar "<*>"+++isFApp :: ParsedLExpr -> Bool+#if __GLASGOW_HASKELL__ <= 710+isFApp (GHC.L _ (GHC.HsVar rdrNm)) = (GHC.mkVarUnqual (fsLit "<*>")) == rdrNm+#else+isFApp (GHC.L _ (GHC.HsVar (GHC.L _ rdrNm))) = (GHC.mkVarUnqual (fsLit "<*>")) == rdrNm+#endif+isFApp _ = False++lLApp :: RefactGhc ParsedLExpr+lLApp = lApp >>= locate++lApp :: RefactGhc ParsedExpr+lApp = hsVar "<*"++lRApp :: RefactGhc ParsedLExpr+lRApp = rApp >>= locate++rApp :: RefactGhc ParsedExpr+rApp = hsVar "*>"++lInfixFmap :: RefactGhc ParsedLExpr+lInfixFmap = infixFmap >>= locate++infixFmap :: RefactGhc ParsedExpr+infixFmap = hsVar "<$>"++-- TODO: Move this to Utils/Variables.hs, but make it lhsVar+hsVar :: String -> RefactGhc ParsedExpr+hsVar n = do+#if __GLASGOW_HASKELL__ <= 710+  return (GHC.HsVar (mkRdrName n))+#else+  lNm <- locate $ mkRdrName n+  liftT $ addSimpleAnnT lNm (DP (0,0)) [(G GHC.AnnVal,DP (0,0))]+  return (GHC.HsVar lNm)+#endif

@@ -90,6 +90,7 @@      -> RefactGhc [ApplyRefacResult] compLiftToTopLevel fileName (row,col) = do       parseSourceFileGhc fileName+      logParsedSource "liftToMod orig:"       parsed  <- getRefactParsed       nm <- getRefactNameMap @@ -131,7 +132,7 @@                mod -- the scoped abstract syntax tree of the module.                pn  -- the function/pattern name to be lifted. -}-liftToTopLevel' :: GHC.ModuleName -- -> (ParseResult,[PosToken]) -> FilePath+liftToTopLevel' :: GHC.ModuleName                 -> GHC.Located GHC.Name                 -> RefactGhc [ApplyRefacResult] liftToTopLevel' modName pn@(GHC.L _ n) = do@@ -167,7 +168,7 @@          parsed' <- getRefactParsed          parsed  <- liftT $ balanceAllComments parsed'          nm      <- getRefactNameMap-         logDataWithAnns "parsed after balanceAllComments" parsed+         -- logDataWithAnns "parsed after balanceAllComments" parsed          declsp <- liftT $ hsDecls parsed          (before,parent,after) <- divideDecls declsp pn          {- ++AZ++TODO: reinstate this, hsDecls does : hsBinds does not return class or instance definitions@@ -176,14 +177,20 @@          when (isInstDecl $ ghead "liftToMod" parent)                $ error "Sorry, the refactorer cannot lift a definition from an instance declaration!"          -}-         nameMap <- getRefactNameMap          -- declsParent <- liftT $ hsDecls (ghead "liftToMod" parent)          -- logm $ "liftToMod:(declsParent)=" ++ (showGhc declsParent)-         let liftedDecls = definingDeclsRdrNames nameMap [n] parent True True-             declaredPns = nub $ concatMap (definedNamesRdr nameMap) liftedDecls-             liftedSigs  = definingSigsRdrNames nameMap declaredPns parent+         let liftedDecls = definingDeclsRdrNames nm [n] parent True True+             declaredPns = nub $ concatMap (definedNamesRdr nm) liftedDecls+             liftedSigs  = definingSigsRdrNames nm declaredPns parent              mLiftedSigs = liftedSigs ++         -- logDataWithAnns "liftedDecls" liftedDecls++         -- Check that the lifted declaration does not include a tuple pattern on the lhs+         when (any isTupleDecl liftedDecls) $ do+           error "Cannot lift a declaration assigning to a tuple pattern"+          -- TODO: what about declarations between this          -- one and the top level that are used in this one? @@ -194,21 +201,26 @@          let dd = getDeclaredVarsRdr nm decls          logm $ "liftToMod:(ddd)=" ++ (showGhc dd) -         if pns == []+         if null pns            then do              (parent',liftedDecls',mLiftedSigs') <- addParamsToParentAndLiftedDecl n dd parent liftedDecls mLiftedSigs -             let defName  = (ghead "liftToMod" (definedNamesRdr nameMap (ghead "liftToMod2" parent')))+             let defName  = ghead "liftToMod" (definedNamesRdr nm (ghead "liftToMod2" parent'))              parsed1 <- liftT $ replaceDecls parsed (before++parent'++after)              parsed2 <- moveDecl1 parsed1 (Just defName) [GHC.unLoc pn] liftedDecls'                                                             declaredPns mLiftedSigs'              putRefactParsed parsed2 emptyAnns +             logParsedSource "liftToMod done:"+              return declaredPns             else askRenamingMsg pns "lifting" -+isTupleDecl :: GHC.LHsDecl GHC.RdrName -> Bool+isTupleDecl (GHC.L _ (GHC.ValD (GHC.PatBind (GHC.L _ GHC.TuplePat {}) _ _ _ _))) = True+isTupleDecl (GHC.L _ (GHC.ValD (GHC.PatBind (GHC.L _ (GHC.AsPat _ (GHC.L _ GHC.TuplePat {}))) _ _ _ _))) = True+isTupleDecl _ = False  -- --------------------------------------------------------------------- 

@@ -1,21 +1,32 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-} module Language.Haskell.Refact.Refactoring.Renaming   ( rename   , compRename   ) where +import qualified Data.Generics         as SYB import qualified GHC.SYB.Utils         as SYB  import qualified GHC import qualified Name                  as GHC+-- import qualified OccName               as GHC+import qualified Outputable            as GHC import qualified RdrName               as GHC  import Control.Monad+import Data.Generics.Strafunski.StrategyLib.StrategyLib hiding (liftIO,MonadPlus,mzero) import Data.List--import qualified Language.Haskell.GhcMod as GM (Options(..))+import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Utils import Language.Haskell.Refact.API import System.Directory+import qualified Language.Haskell.GhcMod as GM (Options(..))+import qualified Data.Map as Map +{-# ANN module "HLint: ignore Redunant do" #-}+{-# ANN module "HLint: ignore Eta reduce" #-}+ {-This refactoring renames an indentifier to a user-specified name.    Conditions:@@ -69,41 +80,32 @@     -- logDataWithAnns "parsed" parsed      let modName = maybe (GHC.mkModuleName "Main") fst $ getModuleName parsed-        maybePn = locToRdrName (row, col) parsed -    logm $ "Renamed.comp:maybePn=" ++ showGhc maybePn -- ++AZ++--    case maybePn of-        Just pn'@(GHC.L l _) -> do+    case locToRdrName (row, col) parsed of+        Just pn'@(GHC.L l rdrName) -> 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-            let rdrNameStr = GHC.occNameString $ GHC.rdrNameOcc rdrName-            logm $ "Renaming: rdrName=" ++ SYB.showData SYB.Parser 0 rdrName-            logm $ "Renaming: occname rdrName=" ++ show (GHC.occNameString $ GHC.rdrNameOcc rdrName)+            let occName = GHC.rdrNameOcc rdrName+            let rdrNameStr = GHC.occNameString occName +            logm $ "Renaming:original occName attributes:" ++ showGhc occName ++ occAttributes occName+             unless (nameToString n /= newName) $ error "The new name is same as the old name"             unless (isValidNewName n rdrNameStr newName) $ error $ "Invalid new name:" ++ newName ++ "!" --            logm $ "Renaming.comp: before GHC.nameModule,n=" ++ showGhc n-             let defineMod = case GHC.nameModule_maybe n of                              Just mn -> GHC.moduleName mn                              Nothing -> modName -            -- TODO: why do we have this restriction?             unless (defineMod == modName) . error $ mconcat [ "This identifier is defined in module "                                                             , GHC.moduleNameString defineMod                                                             , ", please do renaming in that module!"                                                             ]-            logm $ "Renaming.comp:(isMainModule modu,pn)=" ++ showGhcQual (isMainModule modu,pn)             when (isMainModule modu && showGhcQual pn == "Main.main") $                 error "The 'main' function defined in a 'Main' module should not be renamed!" -            logm "Renaming.comp: not main module"             newNameGhc <- mkNewGhcName (Just modu) newName             (refactoredMod, nIsExported) <- applyRefac (doRenaming pn rdrNameStr newName newNameGhc modName)                                            RSAlreadyLoaded@@ -118,78 +120,348 @@         Nothing -> error "Invalid cursor position!"  +-- ---------------------------------------------------------------------++condChecking :: (SYB.Data t)+              => GHC.Name -> String -> GHC.Name -> GHC.ModuleName+              -> t+              -> Bool -> Bool -> RefactGhc ()+condChecking oldPN newName newNameGhc modName ast existChecking exportChecking = do+  condChecking1 oldPN newName newNameGhc modName ast existChecking exportChecking+  nm <- getRefactNameMap+  condChecking2 nm oldPN newName ast++-- ---------------------------------------------------------------------+ -- |Actually do the renaming, split into the various things that can -- be renamed. Returns True if the name is exported doRenaming :: GHC.Located GHC.Name -> String -> String -> GHC.Name -> GHC.ModuleName -> RefactGhc Bool  --------Rename a value variable name-------------------------------- doRenaming pn@(GHC.L _ oldn) rdrNameStr newNameStr newNameGhc modName = do-    logm $ "doRenaming:(pn,rdrNameStr,newNameStr) = " ++ showGhc (pn,rdrNameStr,newNameStr)-    renameTopLevelVarName oldn newNameStr newNameGhc modName True True-    logm "doRenaming done"-    isExported oldn--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+    logm $ "doRenaming:(pn,rdrNameStr,newNameStr) = (" ++ intercalate "," [showGhc pn,rdrNameStr,newNameStr] ++ ")"     parsed <- getRefactParsed     nm <- getRefactNameMap++    if GHC.isVarName oldn+      then do+        decls <- liftT $ hsDeclsGeneric parsed+        if isDeclaredInRdr nm oldn decls+          then do+            logm "doRenaming:renameInMod isDeclaredInRdr True"+            condChecking oldn newNameStr newNameGhc modName parsed True True+            parsed' <- renameTopLevelVarName oldn newNameStr newNameGhc True+            putRefactParsed parsed' mempty+            isExported oldn+          else do+            logm "doRenaming: not declared at the top level"+            condChecking oldn newNameStr newNameGhc modName parsed False False+            parsed' <- renameTopLevelVarName oldn newNameStr newNameGhc False+            putRefactParsed parsed' mempty+            return False -- Not exported+      else do+        logm "doRenaming:not isVarName"+        condChecking oldn newNameStr newNameGhc modName parsed True True+        parsed' <- renameTopLevelVarName oldn newNameStr newNameGhc True+        putRefactParsed parsed' mempty+        isExported oldn++-- ---------------------------------------------------------------------+{-+From Huiqing Li thesis++p 75++The second part is defined in the local function condChecking2. This function+performs a top-down traversal of the AST until it reaches a syntax entity, say+E, such that E contains the declaration of x , and all the references to the x+in question. E could be the Haskell module, a declaration defining a function, a+declaration defining a pattern binding, an expression, a branch in a+case-expression, or a do statement. The syntax phrase E forms the context for+condition checking, and at the place where it is reached, the function+condChecking' is called, and the traversal terminates.++Inside the function condChecking' , three conditions are checked.++  - The first condition ensures that the new name does not exist in the same+    binding group, where the function declaredVarsInSameGroup (from the API) is+    used to fetch all the variable names declared in the same binding group+    where x [AZ: The old name] is declared.++  - The second condition checks whether the new name will intervene between the+    existing uses of y [AZ: the new name] and its bindings, where function+    hsFreeAndDeclaredNames is used to fetch the free and declared variables in+    the argument syntax phrase.++  - The third condition checks whether the new name is declared somewhere+    between the declaration of identifier to be renamed and one of its+    call-sites, and function hsVisibleNames is used to collect the names which+    are declared in the given syntax phrase and visible to one of the call-sites+    of the identifier.++In the local functions, including inMatch, inPattern, and inAlt , the values+defaultPNT and/or [ ] are used to shadow those variables declared in the same+syntax phrase but in an outer scope.++-}++-- |Some non-trivial condition checking.+-- Returns on success, throws an error on check failure+condChecking2 :: (SYB.Data t) => NameMap -> GHC.Name -> String -> t -> RefactGhc ()+condChecking2 nm oldPN newName t = do+  void $ applyTP (once_buTP (failTP `adhocTP` inMod+                             `adhocTP` inMatch+                             `adhocTP` inExp+                             `adhocTP` inStmts+                             `adhocTP` inDataDefn+                             `adhocTP` inConDecl+                             `adhocTP` inTyClDecl+                     )) t+  where+    -- return True if oldPN is declared by t.+    isDeclaredBy t = isDeclaredBy' t+      where+        isDeclaredBy' t+          = do (_ , d) <- hsFreeAndDeclaredPNs t+               -- logDataWithAnns "isDeclaredBy:t" t+               logm $ "isDeclaredBy:d=" ++ showGhc d+               return (oldPN `elem` d )++    -- The name is a top-level identifier+    inMod (parsed :: GHC.ParsedSource) = do+      decls <- liftT $ hsDeclsGeneric parsed+      isDeclared <- isDeclaredBy decls+      logm $ "Renaming.condChecking2.inMod:isDeclared=" ++ show isDeclared+      if isDeclared+           then condChecking' parsed+           else mzero++    -- The name is declared in a function definition.+#if __GLASGOW_HASKELL__ <= 710+    inMatch (GHC.Match f@(Just (ln,_)) pats  mtype (GHC.GRHSs rhs ds)+             ::GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#else+    inMatch (GHC.Match f@(GHC.FunBindMatch ln isInfix) pats  mtype (GHC.GRHSs rhs ds)+             ::GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+#endif+      isDeclaredPats <- isDeclaredBy pats+      isDeclaredDs   <- isDeclaredBy ds+      logm $ "Renaming.condChecking2.inMatch:isDeclared=" ++ show (isDeclaredPats,isDeclaredDs)+      if isDeclaredPats+        then condChecking' (GHC.Match f pats mtype (GHC.GRHSs rhs ds))+        else if isDeclaredDs+          then condChecking' (GHC.Match f []  mtype (GHC.GRHSs rhs ds))+          else mzero+    inMatch _ = mzero++    -- The name is declared in a expression.+    inExp expr@((GHC.L _ (GHC.HsLet ds e)):: GHC.LHsExpr GHC.RdrName) = do+      isDeclaredDs   <- isDeclaredBy ds+      -- logm $ "inExp.HsLet:isDeclaredDs=" ++ show isDeclaredDs+      if isDeclaredDs+        then condChecking' expr+        else mzero+    inExp expr@((GHC.L _ (GHC.HsDo _ ds e)):: GHC.LHsExpr GHC.RdrName) = do+      isDeclared   <- isDeclaredBy ds+      -- logDataWithAnns "inExp.HsDo:expr" expr+      logm $ "inExp.HsDo:isDeclared=" ++ show isDeclared+      if isDeclared+        then condChecking' expr+        else mzero+    inExp _ = mzero+{-+    -- The name is declared in a expression.+    inExp (exp@(Exp (HsLambda pats body))::HsExpP)+      |isDeclaredBy pats+      = condChecking' exp+    inExp (exp@(Exp (HsLet ds e)):: HsExpP)+      |isDeclaredBy ds+      = condChecking' exp+    inExp _ = mzero++    -- The name is declared in a case alternative.+    inAlt (alt@(HsAlt loc p rhs ds)::HsAltP)+      |isDeclaredBy p+      = condChecking' alt+      |isDeclaredBy ds+      = condChecking' (HsAlt loc defaultPat rhs ds)+      |otherwise = mzero++-}++    inStmts (stmt@(GHC.L _ (GHC.LetStmt binds)) :: GHC.LStmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do+      isDeclared   <- isDeclaredBy binds+      if isDeclared+        then condChecking' stmt+        else mzero+    inStmts _ = mzero++    inDataDefn dd@(GHC.HsDataDefn _ ctxt mctype mkindsig cons derivs :: GHC.HsDataDefn GHC.RdrName) = do+      declared <- isDeclaredBy cons+      if declared+        then condChecking' dd+        else mzero++    -- The name is declared in a ConDecl+#if __GLASGOW_HASKELL__ <= 710+    inConDecl (cd@(GHC.ConDecl ns _expr (GHC.HsQTvs _ns bndrs) ctxt+                               dets res _ depc_syntax) :: GHC.ConDecl GHC.RdrName ) =+      case res of+        GHC.ResTyGADT ls typ -> do+          declared <- isDeclaredBy ns+          if declared+            then condChecking' cd+            else mzero+        GHC.ResTyH98 -> do+          declaredn <- isDeclaredBy ns+          declaredd <- isDeclaredBy dets+          if declaredn || declaredd+            then condChecking' cd+            else mzero+#else+    inConDecl cd@(GHC.ConDeclGADT ns _ _ :: GHC.ConDecl GHC.RdrName) = do+      declared <- isDeclaredBy ns+      -- TODO: what about condChecking' ?+      if declared+        then condChecking' cd+        else mzero+    inConDecl cd@(GHC.ConDeclH98 n _ _ dets _) = do+      declaredn <- isDeclaredBy n+      declaredd <- isDeclaredBy dets+      if declaredn || declaredd+        then condChecking' cd+        else mzero+#endif+++#if __GLASGOW_HASKELL__ <= 710+    inTyClDecl dd@(GHC.DataDecl ln (GHC.HsQTvs _ns tyvars) defn _ :: GHC.TyClDecl GHC.RdrName) = do+#else+    inTyClDecl dd@(GHC.DataDecl ln tyvars defn _ _ :: GHC.TyClDecl GHC.RdrName) = do+#endif+      declared <- isDeclaredBy dd+      declaredtv <- isDeclaredBy tyvars+      -- logm $ "condChecking2:inTyClDecl:(declared,declaredtv)=" ++ show (declared,declaredtv)+      if declared || declaredtv+        then condChecking' dd+        else mzero+    inTyClDecl _ = mzero++    -- ---------------------------------++    condChecking' t = do+      sameGroupDecls <- declaredVarsInSameGroup nm oldPN t+      -- logm $ "condChecking':sameGroupDecls=" ++ showGhc sameGroupDecls+      when (newName `elem` sameGroupDecls)+            $ error "The new name exists in the same binding group!"+      (f, d) <- hsFreeAndDeclaredNameStrings t+      when (newName `elem` f) $ error "Existing uses of the new name will be captured!"+      -- fetch all the declared variables in t that+      -- are visible to the places where oldPN occurs.+      ds <- hsVisibleNamesRdr oldPN t+      -- logm $ "Renaming.condChecking':t=" ++ showGhc t+      -- logm $ "Renaming.condChecking':ds=" ++ showGhc ds+      when (newName `elem` ds) $ error "The new name will cause name capture!"+      return t++declaredVarsInSameGroup :: (SYB.Data t) => NameMap -> GHC.Name -> t -> RefactGhc [String]+declaredVarsInSameGroup nm n t = do+  -- simplification: we know we are doing a bottom-up process, stopping where+  -- the name is first declared. Hence the declaration has to be at the current+  -- level of @t@+  decls <- liftT $ hsDeclsGeneric t+  let declared = nub $ map showGhc $ getDeclaredVarsRdr nm decls+  return $ filter (/= showGhc n) declared+++-- ---------------------------------------------------------------------++condChecking1 :: (SYB.Data t)+              => GHC.Name -> String -> GHC.Name -> GHC.ModuleName+              -> t+              -> Bool -> Bool -> RefactGhc ()+condChecking1 oldPN newName newNameGhc modName ast existChecking exportChecking = do+    -- logm $ "condChecking1:(existChecking, exportChecking)=" ++ show (existChecking, exportChecking)+    -- parsed <- getRefactParsed+    nm     <- getRefactNameMap      -- f' contains names imported from other modules;      -- d' contains the top level names declared in this module;-    let (FN f', DN d') = hsFDsFromInsideRdr nm parsed+    let (FN f', DN d') = hsFDsFromInsideRdr nm ast      --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')-    logm $ "renameTopLevelVarName:f=" ++ show f-    logm $ "renameTopLevelVarName:d=" ++ show d+    let (f, _d) = (map nameToString f', map nameToString d')      let newNameStr = nameToString newNameGhc-    logm $ "renameTopLevelVarName:(newName,newNameStr)=" ++ show (newName, newNameStr)      scopeClashNames <- inScopeNames newName -    logm $ "renameTopLevelVarName:(f')=" ++ showGhc f'-    logm $ "renameTopLevelVarName:(scopeClashNames,intersection)=" ++-           showGhc (scopeClashNames, scopeClashNames `intersect` f')-    logm $ "renameTopLevelVarName:(oldPN,modName)=" ++ showGhc (oldPN,modName)-     -- Another implementation option is to add the qualifier to newName automatically.     when (nonEmptyList $ intersect scopeClashNames f') .         error $ mconcat [ "The new name will cause an ambiguous occurrence problem, "                         , "please select another new name or qualify the use of '"                         , newName ++ "' before renaming!\n"] -    when (existChecking && newNameStr `elem` d \\ [nameToString oldPN]) . -- only check the declared names here-        --the same name has been declared in this module.-        error $ mconcat ["Name '", newName, "' already exists in this module\n"]+    parsed <- getRefactParsed+    let dns = map nameToString $ filter (sameNameSpace oldPN) d'+    -- only check the declared names here+    when (existChecking && newNameStr `elem` dns \\ [nameToString oldPN]) $ do+        logm $ "condChecking1:dns=" ++ intercalate "," dns+        let m = Map.fromList $ map (\n -> (nameToString n,n)) $ filter (sameNameSpace oldPN) d'+            Just dupN = Map.lookup newNameStr m+        logm $ "condChecking1:dupN=" ++ showGhcQual dupN +        case definingTyClDeclsNames nm [dupN] parsed of+          [] -> do+            --the same name has been declared in this module.+            error $ mconcat ["Name '", newName, "' already exists in this module\n"]+          ds -> do+            -- TODO: Check that we do not in fact have a name clash. It is only+            -- safe if we are changing a field name where the name clashes with+            -- a field name in another constructor+            return ()+     when (exportChecking && causeNameClashInExports nm oldPN newNameGhc modName parsed) $         error "The new name will cause conflicting exports, please select another new name!"++    causeAmbiguity <- causeAmbiguityInExports oldPN newNameGhc     when (exportChecking && causeAmbiguity) . -- causeAmbiguityInExports oldPN  newNameGhc {- inscps -} renamed         error $ mconcat ["The new name will cause ambiguity in the exports of module '"                         , show modName                         , "' , please select another name!"]-    -- get all of those declared names visible to oldPN at where oldPN is used. -    logm "renameTopLevelVarName:basic tests done"--    isInScopeUnqual <- isInScopeAndUnqualifiedGhc newName (Just newNameGhc)-    logm "renameTopLevelVarName:after isInScopeUnqual"-    logm $ "renameTopLevelVarName:oldPN=" ++ showGhc oldPN-    ds <- hsVisibleNamesRdr oldPN parsed-    logm $ "renameTopLevelVarName:ds computed=" ++ show ds-    when (existChecking && newName `elem` nub (ds `union` f) \\ [nameToString oldPN]) .+    DN ds' <- hsVisibleDsRdr nm oldPN ast+    let dns2 = map nameToString $ filter (sameNameSpace oldPN) ds'+    when (existChecking && newName `elem` nub (dns2 `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"-    let qual = if (exportChecking && isInScopeUnqual) then Qualify else PreserveQualify-    parsed' <- renamePN oldPN newNameGhc qual parsed-    putRefactParsed parsed' mempty-    logm "renameTopLevelVarName done:should have qualified"+-- --------------------------------------------------------------------- +renameTopLevelVarName :: GHC.Name -> String -> GHC.Name+                      -> Bool -> RefactGhc GHC.ParsedSource+renameTopLevelVarName oldPN newName newNameGhc exportChecking = do+    parsed <- getRefactParsed+    isInScopeUnqual <- isInScopeAndUnqualifiedGhc newName (Just newNameGhc)+    let qual = if exportChecking && isInScopeUnqual then Qualify else PreserveQualify+    renamePN oldPN newNameGhc qual parsed++-- ---------------------------------------------------------------------++renameLocalVarName :: (SYB.Data t) => GHC.Name -> String -> GHC.Name -> t -> RefactGhc t+renameLocalVarName oldPN newName newNameGhc t = do+  nm <- getRefactNameMap+  let qual = PreserveQualify+  (f,d) <- hsFDNamesFromInsideRdr t+  if elem newName (d \\ [showGhc oldPN])  --only check the declared names here.+    then error ("Name '"++newName++"'  already existed\n")+    else do -- get all of those declared names visible to oldPN at where oldPN is used.+            ds <- hsVisibleNamesRdr oldPN t+            -- '\\[pNtoName oldPN]' handles the case in which the new name is same as the old name+            if elem newName ((nub (ds `union` f)) \\[showGhc oldPN])+              then error ("Name '"++newName++"'  already existed, or rename '"+                           ++showGhc oldPN++ "' to '"++newName+++                          "' will change the program's semantics!\n")+              else renamePN oldPN newNameGhc qual t+ ------------------------------------------------------------------------  renameInClientMod :: GHC.Name -> String -> GHC.Name -> TargetModule@@ -206,27 +478,19 @@     -- 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     -- checks the GHC.nameUnique value.-    -- gnames <- GHC.getNamesInScope-    -- let clientModule = GHC.nameModule oldPN-    -- let clientInscopes = filter (\n -> clientModule == GHC.nameModule n) gnames-    -- logm $ "renameInClientMod:(clientInscopes)=" ++ showGhcQual (clientInscopes)-    -- let newNames = filter (\n -> showGhcQual n == showGhcQual oldPN) clientInscopes     newNames <- equivalentNameInNewMod oldPN     logm $ "renameInClientMod:(newNames)=" ++ showGhcQual newNames -    -- newNames       <- inScopeNames (showGhcQual oldPN)-    -- newNamesUnqual <- inScopeNames (showGhc     oldPN)-    -- logm $ "renameInClientMod:(newNamesUnqual,oldPN)=" ++ showGhcQual (newNamesUnqual,oldPN)-    -- logm $ "renameInClientMod:(newNames,oldPN)=" ++ showGhcQual (newNames,oldPN)-    -- logm $ "renameInClientMod:(uniques:newNames,oldPN)=" ++ showGhcQual (map GHC.nameUnique newNames,GHC.nameUnique oldPN)-    case newNames of+    let newNames' = filter (sameNameSpace oldPN) newNames+    case newNames' of         []        -> return []-        -- [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+        -- ns -> error $ "HaRe: renameInClientMod: could not find name to replace, got:" ++ showGhcQual ns+        ns -> error $ "HaRe: renameInClientMod: could not find name to replace, got:"+          ++ (showGhcQual $ map (\n -> (n,GHC.occNameSpace $ GHC.nameOccName n)) ns)    where     doRenameInClientMod nm oldNameGhc modName parsed = do@@ -242,7 +506,6 @@          if isInScopeUnqualNew -- ++AZ++: should this be negated?             then do-                -- (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc True)                 (refactoredMod, _) <- applyRefac (refactRenameSimple oldNameGhc newName newNameGhc Qualify)                                                 RSAlreadyLoaded                 return [refactoredMod]@@ -250,7 +513,6 @@                 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                 (refactoredMod, _) <- applyRefac (refactRenameComplex oldNameGhc newName newNameGhc)                                                 RSAlreadyLoaded                 -- TODO: implement rest of this@@ -295,6 +557,8 @@         putRefactParsed parsed mempty         return () +-- ---------------------------------------------------------------------+ causeAmbiguityInExports :: GHC.Name -> GHC.Name -> RefactGhc Bool causeAmbiguityInExports old newName {- inscps -} = do     (GHC.L _ (GHC.HsModule _ exps _imps _decls _ _)) <- getRefactParsed@@ -302,6 +566,8 @@     let usedUnqual = usedWithoutQualR newName exps     logm $ "causeAmbiguityInExports:(isInScopeUnqual,usedUnqual)" ++ show (isInScopeUnqual, usedUnqual)     return (isInScopeUnqual && usedUnqual)++-- ---------------------------------------------------------------------  isValidNewName :: GHC.Name -> String -> String -> Bool isValidNewName oldName rdrNameStr newName = res

@@ -49,7 +49,7 @@               return s            removePar e = return e        p2 <- SYB.everywhereM (SYB.mkM removePar) parsed-       (liftT getAnnsT) >>= putRefactParsed p2+       putRefactParsed p2 emptyAnns        logm $ "logm: after refactor\n" ++ showGhc p2  -- EOF

@@ -12,20 +12,32 @@   , setAnnKeywordDP   , clearPriorComments   , balanceAllComments+  , locate+  , addEmptyAnn+  , addAnnVal+  , addAnn+  , zeroDP+  , setDP+  , handleParseResult+  , removeAnns+  , synthesizeAnns+  , addNewKeyword+  , addNewKeywords   ) 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.GHC.ExactPrint.Utils import Language.Haskell.Refact.Utils.GhcUtils +import Language.Haskell.Refact.Utils.Monad+import Language.Haskell.Refact.Utils.MonadFunctions+ import qualified Data.Map as Map  -- ---------------------------------------------------------------------@@ -159,4 +171,109 @@       unless (null decls) $ moveTrailingComments t (last decls)       return t --- ---------------------------------------------------------------------+--This generates a unique location and wraps the given ast chunk with that location+--Also adds an empty annotation at that location+locate :: (SYB.Data a) => a -> RefactGhc (GHC.Located a)+locate ast = do+  loc <- liftT uniqueSrcSpanT+  let res = (GHC.L loc ast)+  addEmptyAnn res+  return res++--Adds an empty annotation at the provided location+addEmptyAnn :: (SYB.Data a) => GHC.Located a -> RefactGhc ()+addEmptyAnn a = addAnn a annNone++--Adds an "AnnVal" annotation at the provided location+addAnnVal :: (SYB.Data a) => GHC.Located a -> RefactGhc ()+addAnnVal a = addAnn a valAnn+  where valAnn = annNone {annEntryDelta = DP (0,1), annsDP = [(G GHC.AnnVal, DP (0,0))]}++--Adds the given annotation at the provided location+addAnn :: (SYB.Data a) => GHC.Located a -> Annotation -> RefactGhc ()+addAnn a ann = do+  currAnns <- fetchAnnsFinal+  let k = mkAnnKey a+  setRefactAnns $ Map.insert k ann currAnns++--Sets the entry delta position of an ast chunk+setDP :: (SYB.Data a) => DeltaPos -> GHC.Located a -> RefactGhc ()+setDP dp ast = do+  currAnns <- fetchAnnsFinal+  let k = mkAnnKey ast+      mv = Map.lookup k currAnns+  case mv of+    Nothing -> return ()+    Just v -> addAnn ast (v {annEntryDelta = dp})++--Resets the given AST chunk's delta position to zero.+zeroDP :: (SYB.Data a) => GHC.Located a -> RefactGhc ()+zeroDP = setDP (DP (0,0))++--This just pulls out the successful result from an exact print parser or throws an error if the parse was unsuccessful.+handleParseResult :: String -> Either (GHC.SrcSpan, String) (Anns, a) -> RefactGhc (Anns, a)+handleParseResult msg e = case e of+  (Left (_, errStr)) -> error $ "The parse from: " ++ msg ++ " with error: " ++ errStr+  (Right res) -> return res++-- This creates an empty annotation for every located item where an annotation does not already exist in the given AST chunk+synthesizeAnns :: (SYB.Data a) => a -> RefactGhc a+synthesizeAnns = generic `SYB.ext2M` located+  where generic :: SYB.Data a => a -> RefactGhc a+        generic a = do+          _ <- SYB.gmapM synthesizeAnns a+          return a+        located :: (SYB.Data b, SYB.Data loc) => GHC.GenLocated loc b -> RefactGhc (GHC.GenLocated loc b)+        located b@(GHC.L ss a) = case SYB.cast ss of+          Just (s :: GHC.SrcSpan) -> do+            --logm $ "Located found: " ++ (show $ toConstr a)+            anns <- fetchAnnsFinal+            let castRes = (GHC.L s a)+                ann = getAnnotationEP castRes anns+            --logm $ "Found ann: " ++ show ann+            case ann of+              Nothing -> do+                --logm "No ann found for located item"+                let newKey = mkAnnKey castRes+                    newAnns = Map.insert newKey annNone anns+                setRefactAnns newAnns+                return ()+              _ -> return ()+            _ <- SYB.gmapM synthesizeAnns b+            return b+          Nothing ->+            return b++-- This removes all the annotations associated with the given AST chunk.+removeAnns :: (SYB.Data a) => a -> RefactGhc a+removeAnns = generic `SYB.ext2M` located+  where generic :: SYB.Data a => a -> RefactGhc a+        generic a = do+          _ <- SYB.gmapM synthesizeAnns a+          return a+        located :: (SYB.Data b, SYB.Data loc) => GHC.GenLocated loc b -> RefactGhc (GHC.GenLocated loc b)+        located b@(GHC.L ss a) = case SYB.cast ss of+          Just (s :: GHC.SrcSpan) -> do+            anns <- fetchAnnsFinal+            let k = mkAnnKey (GHC.L s a)+            logm $ "Deleting ann at: " ++ (show s)+            setRefactAnns $ Map.delete k anns+            _ <- SYB.gmapM removeAnns b+            return b+          Nothing -> return b++--This takes in a located ast chunk and adds the provided keyword and delta position into the annsDP list+--If there is not annotation associated with the chunk nothing happens+addNewKeyword :: (SYB.Data a) => (KeywordId, DeltaPos) -> GHC.Located a -> RefactGhc ()+addNewKeyword entry a = do+  anns <- liftT getAnnsT+  let key = mkAnnKey a+      mAnn = Map.lookup key anns+  case mAnn of+    Nothing -> return ()+    (Just ann) -> do+      let newAnn = ann{annsDP = (entry:(annsDP ann))}+      setRefactAnns $ Map.insert key newAnn anns++addNewKeywords :: (SYB.Data a) => [(KeywordId, DeltaPos)] -> GHC.Located a -> RefactGhc ()+addNewKeywords entries a = mapM_ ((flip addNewKeyword) a) entries

@@ -8,11 +8,10 @@   ) where  -- GHC imports-#if __GLASGOW_HASKELL__ > 710-import BasicTypes-#endif import Digraph+#if __GLASGOW_HASKELL__ <= 710 import FastString+#endif import GHC import HscTypes import Panic

@@ -20,7 +20,8 @@     , everywhereStaged     , everywhereStaged'     , listifyStaged-+    , everywhereButM+           -- ** SYB Utility     -- , checkItemRenamer @@ -80,6 +81,16 @@        gmapM (everywhereM' f) x'  -- ---------------------------------------------------------------------++-- Monadic everywhereBut+-- Traversal ceases if q holds for x++everywhereButM :: Monad m => SYB.GenericQ Bool -> SYB.Generic m -> SYB.GenericM m+everywhereButM q f x+  | q x = return x+  | otherwise = do+      x' <- f x+      gmapM (everywhereButM q f) x'  -- | Bottom-up transformation everywhereStaged ::  SYB.Stage -> (forall a. Data a => a -> a) -> forall a. Data a => a -> a

@@ -13,7 +13,8 @@   , ghcSpanStartEnd   , getStartEndLoc   , startEndLocGhc-  , emptyList, nonEmptyList+  , emptyList+  , nonEmptyList   ) where  @@ -158,5 +159,3 @@     importDecl (GHC.L l _) = Just l  -- -----------------------------------------------------------------------

@@ -51,6 +51,7 @@ import Exception import qualified Language.Haskell.GhcMod             as GM import qualified Language.Haskell.GhcMod.Internal    as GM+import qualified Language.Haskell.GhcMod.Monad.Out   as GM import qualified Language.Haskell.GhcMod.Monad.Types as GM import Language.Haskell.Refact.Utils.Types import Language.Haskell.GHC.ExactPrint@@ -96,7 +97,7 @@ data RefactStashId = Stash !String deriving (Show,Eq,Ord)  data RefactModule = RefMod-        { rsTypecheckedMod  :: !GHC.TypecheckedModule+        { rsTypecheckedMod  :: !TypecheckedModule         , rsNameMap         :: NameMap           -- ^ Mapping from the names in the ParsedSource to the renamed           -- versions. Note: No strict mark, can be computed lazily.@@ -166,7 +167,7 @@  -- |Result of parsing a Haskell source file. It is simply the -- TypeCheckedModule produced by GHC.-type ParseResult = GHC.TypecheckedModule+type ParseResult = TypecheckedModule  -- |Provide some temporary storage while the refactoring is taking -- place@@ -216,7 +217,11 @@ -- ---------------------------------------------------------------------  instance GM.GmOut (StateT RefactState IO) where+  gmoAsk = lift GM.gmoAsk +instance GM.GmOut IO where+  gmoAsk = GM.gmoAsk+ instance GM.MonadIO (StateT RefactState IO) where   liftIO = liftIO @@ -248,9 +253,13 @@   where     doCabalModuleGraphs :: (GM.IOish m) => GM.GhcModT m [GM.GmModuleGraph]     doCabalModuleGraphs = do-      mcs <- GM.cabalResolvedComponents-      let graph = map GM.gmcHomeModuleGraph $ Map.elems mcs-      return $ graph+      crdl <- GM.cradle+      case GM.cradleCabalFile crdl of+        Just _ -> do+          mcs <- GM.cabalResolvedComponents+          let graph = map GM.gmcHomeModuleGraph $ Map.elems mcs+          return $ graph+        Nothing -> return []  -- --------------------------------------------------------------------- 

@@ -1,11 +1,13 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- For HasTransform+ -- |  -- This module provides the primary interface to the combined@@ -33,6 +35,7 @@        -- * Annotations        -- , addRefactAnns        , setRefactAnns+       , mergeRefactAnns         -- *        , putParsedModule@@ -67,7 +70,8 @@        , logAnns        , logParsedSource        , logExactprint-+       , exactPrintParsed+       , exactPrintExpr        -- * For use by the tests only        , initRefactModule        , initTokenCacheLayout@@ -87,6 +91,7 @@ #endif  import qualified Data.Generics as SYB+-- import qualified GHC.SYB.Utils as SYB  import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Annotate@@ -110,7 +115,7 @@  -- --------------------------------------------------------------------- -getTypecheckedModule :: RefactGhc GHC.TypecheckedModule+getTypecheckedModule :: RefactGhc TypecheckedModule getTypecheckedModule = do   mtm <- gets rsModule   case mtm of@@ -138,7 +143,7 @@ getRefactRenamed = do   mtm <- gets rsModule   let tm = gfromJust "getRefactRenamed" mtm-  return $ gfromJust "getRefactRenamed2" $ GHC.tm_renamed_source $ rsTypecheckedMod tm+  return $ tmRenamedSource $ rsTypecheckedMod tm  putRefactRenamed :: GHC.RenamedSource -> RefactGhc () putRefactRenamed renamed = do@@ -146,7 +151,7 @@   mrm <- gets rsModule   let rm = gfromJust "putRefactRenamed" mrm   let tm = rsTypecheckedMod rm-  let tm' = tm { GHC.tm_renamed_source = Just renamed }+  let tm' = tm { tmRenamedSource = renamed }   let rm' = rm { rsTypecheckedMod = tm' }   put $ st {rsModule = Just rm'} @@ -156,7 +161,7 @@   let tm = gfromJust "getRefactParsed" mtm   let t  = rsTypecheckedMod tm -  let pm = GHC.tm_parsed_module t+  let pm = tmParsedModule t   return $ GHC.pm_parsed_source pm  putRefactParsed :: GHC.ParsedSource -> Anns -> RefactGhc ()@@ -169,8 +174,8 @@   -- let tk' = modifyAnns (rsTokenCache rm) (const newAnns)   let tk' = modifyAnns (rsTokenCache rm) (mergeAnns newAnns) -  let pm = (GHC.tm_parsed_module tm) { GHC.pm_parsed_source = parsed }-  let tm' = tm { GHC.tm_parsed_module = pm }+  let pm = (tmParsedModule tm) { GHC.pm_parsed_source = parsed }+  let tm' = tm { tmParsedModule = pm }   let rm' = rm { rsTypecheckedMod = tm', rsTokenCache = tk', rsStreamModified = RefacModified }   put $ st {rsModule = Just rm'} @@ -183,6 +188,14 @@   (Map.! mainTid) . tkCache . rsTokenCache . gfromJust "getRefactAnns"     <$> gets rsModule +-- |Merges new annotations with the currecnt annotations from the+-- RefactGhc state.+mergeRefactAnns :: Anns -> RefactGhc ()+mergeRefactAnns anns = do+  currAnns <- getRefactAnns+  let newAnns = Map.union anns currAnns+  setRefactAnns newAnns+ -- |Internal low level interface to access the current annotations from the -- RefactGhc state. setRefactAnns :: Anns -> RefactGhc ()@@ -212,7 +225,7 @@  -- ---------------------------------------------------------------------- -putParsedModule :: [Comment] -> GHC.TypecheckedModule -> RefactGhc ()+putParsedModule :: [Comment] -> TypecheckedModule -> RefactGhc () putParsedModule cppComments tm = do   st <- get   put $ st { rsModule = initRefactModule cppComments tm }@@ -311,7 +324,7 @@   case mtm of     Nothing  -> return Nothing     Just tm -> return $ Just (fileNameFromModSummary $ GHC.pm_mod_summary-                              $ GHC.tm_parsed_module $ rsTypecheckedMod tm)+                              $ tmParsedModule $ rsTypecheckedMod tm)  -- --------------------------------------------------------------------- @@ -331,7 +344,7 @@     Nothing  -> error $ "Hare.MonadFunctions.getRefactModule:no module loaded"     Just tm -> do       let t  = rsTypecheckedMod tm-      let pm = GHC.tm_parsed_module t+      let pm = tmParsedModule t       return (GHC.ms_mod $ GHC.pm_mod_summary pm)  -- ---------------------------------------------------------------------@@ -426,14 +439,35 @@  -- --------------------------------------------------------------------- -initRefactModule :: [Comment] -> GHC.TypecheckedModule -> Maybe RefactModule+--Useful helper function that logs the current refact parsed++exactPrintParsed :: RefactGhc ()+exactPrintParsed = do+  parsed <- getRefactParsed+  anns <- fetchAnnsFinal+  let str = exactPrint parsed anns+  logm str++-- ---------------------------------------------------------------------+--A helper function that logs chunks of ast++exactPrintExpr :: Annotate ast => GHC.Located ast -> RefactGhc ()+exactPrintExpr ast = do+  anns <- fetchAnnsFinal+  let str = exactPrint ast anns+  logm str++-- ---------------------------------------------------------------------+++initRefactModule :: [Comment] -> TypecheckedModule -> Maybe RefactModule initRefactModule cppComments tm   = Just (RefMod { rsTypecheckedMod = tm                  , rsNameMap = initRdrNameMap tm                  , rsTokenCache = initTokenCacheLayout (relativiseApiAnnsWithComments                                      cppComments-                                    (GHC.pm_parsed_source $ GHC.tm_parsed_module tm)-                                    (GHC.pm_annotations $ GHC.tm_parsed_module tm))+                                    (GHC.pm_parsed_source $ tmParsedModule tm)+                                    (GHC.pm_annotations $ tmParsedModule tm))                  , rsStreamModified = RefacUnmodifed                  }) @@ -450,13 +484,13 @@ -- with the wrinkle that we need to Location of the RdrName to make sure we have -- the right Name, but not all RdrNames have a Location. -- This function is called before the RefactGhc monad is active.-initRdrNameMap :: GHC.TypecheckedModule -> NameMap+initRdrNameMap :: TypecheckedModule -> NameMap initRdrNameMap tm = r   where-    parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module tm-    renamed = gfromJust "initRdrNameMap" $ GHC.tm_renamed_source tm+    parsed  = GHC.pm_parsed_source $ tmParsedModule tm+    renamed = tmRenamedSource tm #if __GLASGOW_HASKELL__ > 710-    typechecked = GHC.tm_typechecked_source tm+    typechecked = tmTypecheckedSource tm #endif      checkRdr :: GHC.Located GHC.RdrName -> Maybe [(GHC.SrcSpan,GHC.RdrName)]

@@ -0,0 +1,53 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Language.Haskell.Refact.Utils.Query where+--This module contains functions that retrieve sections of the ast. It is fairly high level.++import qualified GHC as GHC+import Language.Haskell.Refact.Utils.Monad+import Language.Haskell.Refact.Utils.Synonyms+import Language.Haskell.Refact.Utils.Types+import Language.Haskell.Refact.Utils.TypeUtils+import Data.Generics as SYB+import GHC.SYB.Utils as SYB+import Control.Applicative+import FastString+import RdrName++--Takes a single match and returns a tuple containing the grhs and the pattern+--Assumptions:+  -- Only a single pattern will be returned. Which pattern is returned depends on the behaviour of SYB.something. +getVarAndRHS :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LPat GHC.RdrName, ParsedGRHSs)+getVarAndRHS match = do+  let (Just pat) = SYB.something (Nothing `SYB.mkQ` varPat) (GHC.m_pats match)+  return (pat , GHC.m_grhss match)+    where varPat lPat@(GHC.L _ (GHC.VarPat _ )) = Just lPat+          varPat _ = Nothing++--Looks up the function binding at the given position. Returns nothing if the position does not contain a binding.+getHsBind :: (Data a) => SimpPos -> String -> a -> Maybe (GHC.HsBind GHC.RdrName)+getHsBind pos funNm a =+  let rdrNm = locToRdrName pos a in+  case rdrNm of+  Nothing -> Nothing+  (Just (GHC.L _ rNm)) -> SYB.everythingStaged SYB.Parser (<|>) Nothing (Nothing `SYB.mkQ` isBind) a+    where+#if __GLASGOW_HASKELL__ <= 710+        isBind (bnd@(GHC.FunBind (GHC.L _ name) _ _ _ _ _) :: GHC.HsBind GHC.RdrName)+#else+        isBind (bnd@(GHC.FunBind (GHC.L _ name) _ _ _ _) :: GHC.HsBind GHC.RdrName)+#endif+            | name == rNm = (Just bnd)+        isBind _ = Nothing++--It's common to want to know if an expression is just a certain var+--This function takes a String of the var and returns true of the given expression represents that var+isHsVar :: String -> ParsedExpr -> Bool+#if __GLASGOW_HASKELL__ <= 710+isHsVar str (GHC.HsVar rNm) =+#else+isHsVar str (GHC.HsVar (GHC.L _ rNm)) =+#endif+  let nm = mkVarUnqual (fsLit str) in+    rNm == nm+isHsVar _ _ = False

@@ -0,0 +1,15 @@+module Language.Haskell.Refact.Utils.Synonyms where+import GHC++{-+This file has synonyms for commonly used AST parser types.+-}++type UnlocParsedHsBind = HsBindLR RdrName RdrName+type ParsedGRHSs       = GRHSs RdrName (LHsExpr RdrName)+type ParsedMatchGroup  = MatchGroup RdrName (LHsExpr RdrName)+type ParsedLMatch      = LMatch RdrName (LHsExpr RdrName)+type ParsedExpr        = HsExpr RdrName+type ParsedLExpr       = LHsExpr RdrName+type ParsedLStmt       = LStmt RdrName (LHsExpr RdrName)+type ParsedBind        = HsBind RdrName

@@ -0,0 +1,111 @@+{-# LANGUAGE CPP #-}+module Language.Haskell.Refact.Utils.Transform+  (+    addSimpleImportDecl+  , wrapInLambda+  , wrapInPars+  , wrapInParsWithDPs+  , addNewLines+  , locate+  , removePars+  ) where++import qualified GHC as GHC+import qualified BasicTypes as GHC+import qualified Data.Map as Map+import Data.Data++import Language.Haskell.GHC.ExactPrint+import Language.Haskell.GHC.ExactPrint.Types++import Language.Haskell.Refact.Utils.Monad+import Language.Haskell.Refact.Utils.MonadFunctions+import Language.Haskell.Refact.Utils.TypeUtils+import Language.Haskell.Refact.Utils.Synonyms+import Language.Haskell.Refact.Utils.ExactPrint++-- The goal of this module is to provide basic transformations of the ast and+-- annotations that are useful in multiple refactorings+++--Takes in a string corresponding to the module name to be imported+--Adds the import declaration at the end of that module's imports +addSimpleImportDecl :: String -> RefactGhc ()+addSimpleImportDecl modName = do+  let modNm' = GHC.mkModuleName modName+  parsed <- getRefactParsed+  newP <- addImportDecl parsed modNm' Nothing False False False Nothing False []+  currAnns <- fetchAnnsFinal+  putRefactParsed newP currAnns++--Takes in a lhs pattern and a rhs. Wraps those in a lambda and adds the annotations associated with the lambda. Returns the new located lambda expression++wrapInLambda :: String -> GHC.LPat GHC.RdrName -> ParsedGRHSs -> RefactGhc (GHC.LHsExpr GHC.RdrName)+wrapInLambda funNm varPat rhs = do+  match@(GHC.L l match') <- mkMatch varPat rhs+  --logm $ "Match: " ++ (SYB.showData SYB.Parser 3 match)+#if __GLASGOW_HASKELL__ <= 710+  let mg = GHC.MG [match] [] GHC.PlaceHolder GHC.Generated+#else+  lMatchLst <- locate [match]+  let mg = GHC.MG lMatchLst [] GHC.PlaceHolder GHC.Generated+#endif+  currAnns <- fetchAnnsFinal+  --logm $ "Anns :" ++ (show $ getAllAnns currAnns match)+  let l_lam = (GHC.L l (GHC.HsLam mg))+      key = mkAnnKey l_lam+      dp = [(G GHC.AnnLam, DP (0,0))]+      newAnn = annNone {annsDP = dp}+  setRefactAnns $ Map.insert key newAnn currAnns+  par_lam <- wrapInPars l_lam+  return par_lam++  --This function makes a match suitable for use inside of a lambda expression. Should change name or define it elsewhere to show that this is not a general-use function. +mkMatch :: GHC.LPat GHC.RdrName -> GHC.GRHSs GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LMatch GHC.RdrName (GHC.LHsExpr GHC.RdrName))+mkMatch varPat rhs = do+#if __GLASGOW_HASKELL__ <= 710+  lMatch@(GHC.L l m) <- locate (GHC.Match Nothing [varPat] Nothing rhs)+#else+  lMatch@(GHC.L l m) <- locate (GHC.Match GHC.NonFunBindMatch [varPat] Nothing rhs)+#endif+  let dp = [(G GHC.AnnRarrow, DP (0,1))]+      newAnn = annNone {annsDP = dp, annEntryDelta = DP (0,-1)}+  zeroDP varPat+  addAnn lMatch newAnn+  return lMatch++wrapInParsWithDPs :: DeltaPos -> DeltaPos -> GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+wrapInParsWithDPs openDP closeDP expr = do+  newAst <- locate (GHC.HsPar expr)+  let dp = [(G GHC.AnnOpenP, openDP), (G GHC.AnnCloseP, closeDP)]+      newAnn = annNone {annsDP = dp}+  addAnn newAst newAnn+  return newAst+++--Wraps a given expression in parenthesis and add the appropriate annotations, returns the modified ast chunk. +wrapInPars :: GHC.LHsExpr GHC.RdrName -> RefactGhc (GHC.LHsExpr GHC.RdrName)+wrapInPars = wrapInParsWithDPs (DP (0,1)) (DP (0,0))++--Does the opposite of wrapInPars+removePars :: ParsedLExpr -> RefactGhc ParsedLExpr+removePars (GHC.L _ (GHC.HsPar expr)) = do+  setDP (DP (0,1)) expr+  return expr+removePars expr = return expr++  +--Takes a piece of AST and adds an n row offset+addNewLines :: (Data a) => Int -> GHC.Located a -> RefactGhc ()+addNewLines n ast = do+  currAnns <- fetchAnnsFinal+  let key = mkAnnKey ast+      mv = Map.lookup key currAnns+  case mv of+    Nothing -> return ()+    Just v -> do+      let (DP (row,col)) = annEntryDelta v+          newDP = (DP (row+n,col))+          newAnn = v {annEntryDelta = newDP}+          newAnns = Map.insert key newAnn currAnns+      setRefactAnns newAnns

@@ -51,10 +51,10 @@   ppr x = GHC.text $ show x  + instance GHC.Outputable (GHC.MatchGroup GHC.Name (GHC.LHsExpr GHC.Name)) where   ppr (GHC.MG ms _ _ _) = GHC.text "MatchGroup" GHC.<+> GHC.ppr ms - instance GHC.Outputable (GHC.Match GHC.Name (GHC.LHsExpr GHC.Name)) where   ppr (GHC.Match _fn pats mtyp grhs) = GHC.text "Match" GHC.<+> GHC.ppr pats                                                     GHC.<+> GHC.ppr mtyp@@ -76,11 +76,14 @@   ppr (GHC.Missing _typ) = GHC.text "Missing"  +#if !(defined(MIN_VERSION_GLASGOW_HASKELL) && (MIN_VERSION_GLASGOW_HASKELL(8,0,1,1))) instance GHC.Outputable (GHC.ConDeclField GHC.Name) where   ppr (GHC.ConDeclField name typ doc) = GHC.text "ConDeclField"                                           GHC.<+> GHC.ppr name                                           GHC.<+> GHC.ppr typ                                           GHC.<+> GHC.ppr doc+#endif+ #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"@@ -90,4 +93,3 @@ #endif  -- ----------------------------------------------------------------------

@@ -46,7 +46,8 @@    , hsQualifier      -- ** Property checking-    ,isVarId,isConId,isOperator,isTopLevelPN,isLocalPN,isNonLibraryName+    ,isVarId,isConId,isOperator+    ,isTopLevelPN,isLocalPN,isNonLibraryName     ,isQualifiedPN, isFunOrPatName, isTypeSig, isTypeSigDecl     ,isFunBindP,isFunBindR,isPatBindP,isPatBindR,isSimplePatBind,isSimplePatDecl     ,isComplexPatBind,isComplexPatDecl,isFunOrPatBindP,isFunOrPatBindR@@ -132,10 +133,12 @@   -- Modules from GHC+import qualified Avail         as GHC import qualified FastString    as GHC import qualified GHC           as GHC import qualified Module        as GHC import qualified Name          as GHC+import qualified NameSet       as GHC import qualified Outputable    as GHC import qualified RdrName       as GHC import qualified TyCon         as GHC@@ -206,19 +209,16 @@   -> 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)+  -- 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)+    handler _e = do+      -- logm $ "isInScopeAndUnqualifiedGhc.handler e=" ++ (show _e)       return []  -- ---------------------------------------------------------------------@@ -262,10 +262,10 @@   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)+  -- 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 -> 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@@ -378,9 +378,15 @@ isExported :: GHC.Name -> RefactGhc Bool isExported n = do   typechecked <- getTypecheckedModule-  let modInfo = GHC.tm_checked_module_info typechecked-  return $ GHC.modInfoIsExportedName modInfo n+  -- let modInfo = GHC.tm_checked_module_info typechecked+  -- return $ GHC.modInfoIsExportedName modInfo n+  return $ GHC.elemNameSet n (GHC.availsToNameSet (tmMinfExports typechecked)) ++-- modInfoIsExportedName :: ModuleInfo -> Name -> Bool+-- modInfoIsExportedName minf name = elemNameSet name (availsToNameSet (minf_exports minf))++ -- ---------------------------------------------------------------------  -- | Return True if an identifier is explicitly exported by the module.@@ -398,7 +404,7 @@                         -> GHC.Name          -- ^ The original name                         -> GHC.Name          -- ^ The new name                         -> GHC.ModuleName    -- ^ The identity of the module-                        -> GHC.ParsedSource -- ^ The AST 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.@@ -459,7 +465,7 @@ getModule :: RefactGhc GHC.Module getModule = do   typechecked <- getTypecheckedModule-  return $ GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module typechecked+  return $ GHC.ms_mod $ GHC.pm_mod_summary $ tmParsedModule typechecked  -- --------------------------------------------------------------------- @@ -488,7 +494,7 @@  -- | Returns True if a string lexically is an identifier. -- *This function should not be exported.*-isId::String->Bool+isId :: String -> Bool isId mid = mid/=[] && isLegalIdTail (tail mid) && not (isReservedId mid)   where     isLegalIdTail tail' = all isLegal tail'@@ -507,11 +513,15 @@ isTopLevelPN::GHC.Name -> RefactGhc Bool isTopLevelPN n = do   typechecked <- getTypecheckedModule-  let maybeNames = GHC.modInfoTopLevelScope $ GHC.tm_checked_module_info typechecked+  let maybeNames = modInfoTopLevelScope typechecked   let names = fromMaybe [] maybeNames   return $ n `elem` names +modInfoTopLevelScope :: TypecheckedModule -> Maybe [GHC.Name]+modInfoTopLevelScope tm+  = fmap (map GHC.gre_name . GHC.globalRdrEnvElts) (tmMinfRdrEnv tm) + -- |Return True if a PName is a local PName. isLocalPN::GHC.Name -> Bool isLocalPN = GHC.isInternalName@@ -1043,10 +1053,11 @@ 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))+  let lie = GHC.L newSpan (GHC.IEVar lpn)+  liftT $ addSimpleAnnT lpn (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]+  when addCommaAnn $+    liftT $ addSimpleAnnT lie (DP (0,0)) [((G GHC.AnnComma),DP (0,0))]+  return lie  -- | Represents the operation type we want to select on addItemsToImport' data ImportType = Hide     -- ^ Used for addHiding@@ -1061,7 +1072,7 @@   -> 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+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@@ -1573,7 +1584,7 @@ addActualParamsToRhs :: (SYB.Data t) =>                         GHC.Name -> [GHC.RdrName] -> t -> RefactGhc t addActualParamsToRhs pn paramPNames rhs = do-    logm $ "addActualParamsToRhs:entered:(pn,paramPNames)=" ++ showGhc (pn,paramPNames)+    -- logm $ "addActualParamsToRhs:entered:(pn,paramPNames)=" ++ showGhc (pn,paramPNames)     nameMap <- getRefactNameMap     let        worker :: (GHC.LHsExpr GHC.RdrName) -> RefactGhc (GHC.LHsExpr GHC.RdrName)@@ -1584,7 +1595,7 @@ #endif         | eqRdrNamePure nameMap (GHC.L l2 pname) pn           = do-              logDataWithAnns "addActualParamsToRhs:oldExp=" oldExp+              -- logDataWithAnns "addActualParamsToRhs:oldExp=" oldExp               newExp' <- foldlM addParamToExp oldExp paramPNames                edp <- liftT $ getEntryDPT oldExp@@ -1600,14 +1611,15 @@        addParamToExp expr param = do          ss1 <- liftT $ uniqueSrcSpanT          ss2 <- liftT $ uniqueSrcSpanT-         logm $ "addActualParamsToRhs.addParamsToExp:(ss1,ss2):" ++ showGhc (ss1,ss2)+         -- 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)+         liftT $ addSimpleAnnT var (DP (0,0)) [(G GHC.AnnVal,DP (0,1))] #else          let var   = GHC.L ss2 (GHC.HsVar (GHC.L ss2 param))+         liftT $ addSimpleAnnT (GHC.L ss2 param) (DP (0,0)) [(G GHC.AnnVal,DP (0,1))] #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'@@ -1817,10 +1829,10 @@  rmDecl pn incSig t = do   setStateStorage StorageNone-  t' <- everywhereMStaged' SYB.Parser (SYB.mkM   inModule-                                      `SYB.extM` inLet-                                      `SYB.extM` inMatch-                                      ) t -- top down+  t' <- everywhereM' (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@@ -1939,9 +1951,9 @@ 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')@@ -2129,11 +2141,8 @@ 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@@ -2164,22 +2173,6 @@      -- --------------------------------- -    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@@ -2205,6 +2198,21 @@      -- --------------------------------- +    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 = newNameCalc useQual' n+          new <- makeNewName old nn+          -- logDataWithAnns "renamePN:rename new :" new+          -- logDataWithAnns "renamePN:rename old2 :" old+          return new+       else return old++    -- ---------------------------------+     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@@ -2214,7 +2222,7 @@      nm <- getRefactNameMap      if cond nm (GHC.L l n)        then do-          logm $ "renamePN:renameTyVar at :" ++ (showGhc l)+          -- logm $ "renamePN:renameTyVar at :" ++ (showGhc l)           let nn = newNameCalc useQual' n #if __GLASGOW_HASKELL__ <= 710           ss' <- liftT $ uniqueSrcSpanT@@ -2240,8 +2248,7 @@      nm <- getRefactNameMap      if cond nm (GHC.L l n)        then do-          logm $ "renamePN:renameHsTyVarBndr at :" ++ (showGhc l)-          -- let nn = newNameCalcBool useQual' n+          -- logm $ "renamePN:renameHsTyVarBndr at :" ++ (showGhc l)           let nn = newNameCalc useQual' n #if __GLASGOW_HASKELL__ <= 710           addToNameMap l newName@@ -2334,7 +2341,7 @@      nm <- getRefactNameMap      if cond nm (GHC.L l n)        then do-          logm $ "renamePNworker:renameLPat at :" ++ (showGhc l)+          -- logm $ "renamePNworker:renameLPat at :" ++ (showGhc l)           let nn = newNameCalc useQual' n #if __GLASGOW_HASKELL__ <= 710           ss' <- liftT $ uniqueSrcSpanT@@ -2354,7 +2361,7 @@     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:"+     -- logm $ "renamePN.renameMatch entered:"      pats'  <- renameTransform _useQual pats      ty'    <- renameTransform _useQual ty      grhss' <- renameTransform _useQual grhss@@ -2398,10 +2405,10 @@     renameTypeSig _useQual (GHC.TypeSig ns typ) #endif      = do-         logm $ "renamePN:renameTypeSig"+         -- logm $ "renamePN:renameTypeSig"          ns'  <- mapM (renameLRdr NoQualify) ns          typ' <- renameTransform _useQual typ-         logm $ "renamePN:renameTypeSig done"+         -- logm $ "renamePN:renameTypeSig done" #if __GLASGOW_HASKELL__ <= 710          return (GHC.TypeSig ns' typ' p) #else@@ -2430,6 +2437,9 @@         match      = const True :: GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName) -> Bool         importDecl = const True :: GHC.ImportDecl GHC.RdrName -> Bool +    -- The function that does the actual renaming. It is split out here so it+    -- can be called recursively.+    renameTransform :: (SYB.Data t) => HowToQual -> t -> RefactGhc t     renameTransform useQual' t' =             (everywhereMSkip ( -- top-down, skipping Located Names for Sig/Match                    SYB.mkM   (renameVar         useQual')@@ -2442,8 +2452,7 @@                   `SYB.extM` (renameImportDecl  useQual')                   `SYB.extM` (renameMatch       useQual')                    ) t')-  t' <- renameTransform useQual t-  return t'+  renameTransform useQual t  -- --------------------------------------------------------------------- @@ -2503,7 +2512,7 @@ findIdForName :: GHC.Name -> RefactGhc (Maybe GHC.Id) findIdForName n = do   tm <- getTypecheckedModule-  let t = GHC.tm_typechecked_source tm+  let t = tmTypecheckedSource 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@@ -2586,4 +2595,3 @@ #endif  -- EOF-

@@ -4,6 +4,7 @@        (         ApplyRefacResult        , RefacResult(..)+       , TypecheckedModule(..)        -- *        , TreeId(..)        , mainTid@@ -14,9 +15,9 @@         ) where +import qualified Avail      as GHC import qualified GHC        as GHC--- import qualified Name       as GHC--- import qualified Outputable as GHC+import qualified RdrName    as GHC  import Language.Haskell.GHC.ExactPrint -- import Language.Haskell.GHC.ExactPrint.Utils@@ -31,6 +32,22 @@  data RefacResult = RefacModified | RefacUnmodifed                  deriving (Show,Ord,Eq)++-- ---------------------------------------------------------------------++data TypecheckedModule = TypecheckedModule+  { tmParsedModule      :: !GHC.ParsedModule+  , tmRenamedSource     :: !GHC.RenamedSource+  , tmTypecheckedSource :: !GHC.TypecheckedSource+  -- , tmMinfExports       :: ![GHC.AvailInfo]+  -- , tmMinfRdrEnv        :: !(Maybe GHC.GlobalRdrEnv)   -- Nothing for a compiled/package mod+  , tmMinfExports       :: [GHC.AvailInfo]+  , tmMinfRdrEnv        :: (Maybe GHC.GlobalRdrEnv)   -- Nothing for a compiled/package mod+  }++-- TODO: improve this, or remove it's need+instance Show TypecheckedModule where+  show _ = "TypeCheckedModule(..)"  -- --------------------------------------------------------------------- 

@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}@@ -17,6 +18,7 @@        -- * The bits that do the work        , runRefacSession        , applyRefac+       , applyRefac'        , refactDone         -- , Update(..)@@ -24,6 +26,8 @@        , getModuleName        , clientModsAndFiles        , serverModsAndFiles+       -- , lookupAnns+       , runMultRefacSession         , modifiedFiles        , writeRefactoredFiles@@ -36,11 +40,12 @@ import Control.Monad.Identity import Control.Monad.State import Data.List+import Data.Maybe+import Data.IORef  -- import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Preprocess import Language.Haskell.GHC.ExactPrint.Print-import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils  import qualified Language.Haskell.GhcMod          as GM@@ -57,7 +62,11 @@ import qualified Digraph       as GHC import qualified DynFlags      as GHC import qualified GHC           as GHC--- import qualified Outputable    as GHC+-- import qualified SrcLoc        as GHC+import qualified Hooks         as GHC+import qualified HscMain       as GHC+import qualified HscTypes      as GHC+import qualified TcRnMonad     as GHC  -- import qualified GHC.SYB.Utils as SYB -- import qualified Data.Generics as SYB@@ -82,30 +91,127 @@ getTargetGhc (GM.ModulePath _mn fp) = parseSourceFileGhc fp  -- ---------------------------------------------------------------------+{-+-- | Parse a single source file into a GHC session+parseSourceFileGhc' :: FilePath -> RefactGhc ()+parseSourceFileGhc' targetFile = do+  logm $ "parseSourceFileGhc:targetFile=" ++ show targetFile+  setTargetSession targetFile+  graph  <- GHC.getModuleGraph+  cgraph <- canonicalizeGraph graph+  cfileName <- liftIO $ canonicalizePath targetFile+  let mm = filter (\(mfn,_ms) -> mfn == Just cfileName) cgraph+  case mm of+    [(_,modSum)] -> loadFromModSummary Nothing modSum+    _ -> error $ "HaRe:unexpected error parsing " ++ targetFile+-}+-- ---------------------------------------------------------------------  -- | Parse a single source file into a GHC session parseSourceFileGhc :: FilePath -> RefactGhc () parseSourceFileGhc targetFile = do   logm $ "parseSourceFileGhc:targetFile=" ++ show targetFile-  setTargetSession targetFile-  logm $ "parseSourceFileGhc:after setTargetSession"+  cfileName <- liftIO $ canonicalizePath targetFile+  logm $ "parseSourceFileGhc:cfileName=" ++ show cfileName+  ref <- liftIO $ newIORef (cfileName,Nothing)+  let+    setTarget fileName = RefactGhc $ GM.runGmlT' [Left fileName] (installHooks ref) (return ())+  -- setTarget targetFile+  setTarget cfileName+  logm $ "parseSourceFileGhc:after setTarget"+  (_,mtm) <- liftIO $ readIORef ref+  logm $ "parseSourceFileGhc:isJust mtm:" ++ show (isJust mtm)   graph  <- GHC.getModuleGraph   cgraph <- canonicalizeGraph graph-  cfileName <- liftIO $ canonicalizePath targetFile   let mm = filter (\(mfn,_ms) -> mfn == Just cfileName) cgraph   case mm of-    [(_,modSum)] -> loadFromModSummary modSum+    [(_,modSum)] -> loadFromModSummary mtm modSum+    -- [(_,modSum)] -> loadFromModSummary Nothing modSum     _ -> error $ "HaRe:unexpected error parsing " ++ targetFile  -- --------------------------------------------------------------------- +installHooks :: (Monad m) => IORef (FilePath,Maybe TypecheckedModule) -> GHC.DynFlags -> m GHC.DynFlags+installHooks ref dflags = return $ dflags {+    GHC.hooks = (GHC.hooks dflags) {++#if __GLASGOW_HASKELL__ <= 710+        GHC.hscFrontendHook   = Just $ hscFrontend ref+#else+        GHC.hscFrontendHook   = Just $ runHscFrontend ref+#endif+      }+  }++#if __GLASGOW_HASKELL__ > 710+runHscFrontend :: IORef (FilePath,Maybe TypecheckedModule) -> GHC.ModSummary -> GHC.Hsc GHC.FrontendResult+runHscFrontend ref mod_summary+    = GHC.FrontendTypecheck `fmap` hscFrontend ref mod_summary+#endif++-- ---------------------------------------------------------------------+-- | Given a 'ModSummary', parses and typechecks it, returning the+-- 'TcGblEnv' resulting from type-checking.+-- Based on GHC.hscFileFrontend+--+-- This gets called on every module compiled when loading the wanted target.+-- When it is the wanted target, keep the ParsedSource and TypecheckedSource,+-- with API Annotations enabled.+hscFrontend :: IORef (FilePath,Maybe TypecheckedModule) -> GHC.ModSummary -> GHC.Hsc GHC.TcGblEnv+hscFrontend ref mod_summary = do+    -- liftIO $ putStrLn $ "hscFrontend:entered:" ++ fileNameFromModSummary mod_summary+    (mfn,_) <- canonicalizeModSummary mod_summary+    -- liftIO $ putStrLn $ "hscFrontend:mfn:" ++ show mfn+    (fn,_) <- liftIO $ readIORef ref+    let+      keepInfo = case mfn of+                   Just fileName -> fn == fileName+                   Nothing -> False+    if keepInfo+      then do+        -- liftIO $ putStrLn $ "hscFrontend:in keepInfo"+        let modSumWithRaw = tweakModSummaryDynFlags mod_summary++        hsc_env <- GHC.getHscEnv+        let hsc_env_tmp = hsc_env { GHC.hsc_dflags = GHC.ms_hspp_opts modSumWithRaw }+        hpm <- liftIO $ GHC.hscParse hsc_env_tmp modSumWithRaw+        let p = GHC.ParsedModule mod_summary+                                (GHC.hpm_module      hpm)+                                (GHC.hpm_src_files   hpm)+                                (GHC.hpm_annotations hpm)++        hsc_env' <- GHC.getHscEnv+        (tc_gbl_env,rn_info) <- liftIO $ GHC.hscTypecheckRename hsc_env' mod_summary hpm++        details <- liftIO $ GHC.makeSimpleDetails hsc_env' tc_gbl_env++        let+          tc =+            TypecheckedModule {+              tmParsedModule      = p,+              tmRenamedSource     = gfromJust "hscFrontend" rn_info,+              tmTypecheckedSource = GHC.tcg_binds tc_gbl_env,+              tmMinfExports       = GHC.md_exports details,+              tmMinfRdrEnv        = Just (GHC.tcg_rdr_env tc_gbl_env)+              }++        liftIO $ modifyIORef' ref (const (fn,Just tc))+        return tc_gbl_env+      else do+        hpm <- GHC.hscParse' mod_summary+        hsc_env <- GHC.getHscEnv+        tc_gbl_env <- GHC.tcRnModule' hsc_env mod_summary False hpm+        return tc_gbl_env++-- ---------------------------------------------------------------------+{- setTargetSession :: FilePath -> RefactGhc () -- setTargetSession targetFile = RefactGhc $ GM.runGmlT' [Left targetFile] setDynFlags (return ()) setTargetSession targetFile = RefactGhc $ GM.runGmlT' [Left targetFile] return (return ()) -setDynFlags :: GHC.DynFlags -> GHC.Ghc GHC.DynFlags-setDynFlags df = return (GHC.gopt_set df GHC.Opt_KeepRawTokenStream)-+-- setDynFlags :: GHC.DynFlags -> GHC.Ghc GHC.DynFlags+-- setDynFlags df = return (GHC.gopt_set df GHC.Opt_KeepRawTokenStream)+-} -- ---------------------------------------------------------------------  -- |For GHC 7.10.2, setting 'GHC.Opt_KeepRawTokenStream' prevents the pragmas at@@ -123,18 +229,31 @@  -- | In the existing GHC session, put the requested TypeCheckedModule -- into the RefactGhc monad-loadFromModSummary :: GHC.ModSummary -> RefactGhc ()-loadFromModSummary modSum = do+loadFromModSummary :: Maybe TypecheckedModule -> GHC.ModSummary -> RefactGhc ()+loadFromModSummary mtm modSum = do   logm $ "loadFromModSummary:modSum=" ++ show modSum-  let modSumWithRaw = tweakModSummaryDynFlags modSum-  p <- GHC.parseModule modSumWithRaw-  t <- GHC.typecheckModule p+  t <- case mtm of+    Nothing -> do+      let modSumWithRaw = tweakModSummaryDynFlags modSum+      p <- GHC.parseModule modSumWithRaw+      t' <- GHC.typecheckModule p+      let+        tm = TypecheckedModule+          { tmParsedModule = p+          , tmRenamedSource = gfromJust "loadFromModSummary" $ GHC.tm_renamed_source t'+          , tmTypecheckedSource = GHC.tm_typechecked_source t'+          , tmMinfExports  = error $ "loadFromModSummary:not visible in ModuleInfo 1"+          , tmMinfRdrEnv   = error $ "loadFromModSummary:not visible in ModuleInfo 2"+          }+      return tm+    Just tm -> return tm    -- dflags <- GHC.getDynFlags   -- cppComments <- if (GHC.xopt GHC.Opt_Cpp dflags)   cppComments <- if True                   then do                        -- ++AZ++:TODO: enable the CPP option check some time+                       -- TODO: Set the approriate DynFlag to retain the source, so this can be done more cheaply                        logm $ "loadFromModSummary:CPP flag set"                        case GHC.ml_hs_file $ GHC.ms_location modSum of                          Just fileName -> getCppTokensAsComments defaultCppOptions fileName@@ -158,8 +277,8 @@       settings <- get       put $ settings { rsCurrentTarget = Just newTargetModule } -  mtm <- gets rsModule-  case mtm of+  mtm' <- gets rsModule+  case mtm' of     Just tm -> if ((rsStreamModified tm == RefacUnmodifed)                   && oldTargetModule == Just newTargetModule)                  then do@@ -209,6 +328,63 @@  -- --------------------------------------------------------------------- ++-- | Like runRefacSession but instead takes an ordered list of RefactGhc+-- computations and runs all of them threading the state through all of the+-- computations++runMultRefacSession :: RefactSettings -> GM.Options -> [RefactGhc [ApplyRefacResult]] -> IO [FilePath]+runMultRefacSession settings opt comps = do+  let+    initialState = RefSt+        { rsSettings      = settings+        , rsUniqState     = 1+        , rsSrcSpanCol    = 1+        , rsFlags         = RefFlags False+        , rsStorage       = StorageNone+        , rsCurrentTarget = Nothing+        , rsModule        = Nothing+        }+  results <- threadState opt initialState comps+  let (_, finState) = last results+      verbosity = rsetVerboseLevel (rsSettings finState)+      refResults = map fst results+      merged = mergeRefResults refResults+  writeRefactoredFiles verbosity merged+  return $ modifiedFiles merged++mergeRefResults :: [[ApplyRefacResult]] -> [ApplyRefacResult]+mergeRefResults lst = Map.elems $ mergeHelp lst Map.empty+  where mergeHelp []  mp = mp+        mergeHelp (x:xs) mp = mergeHelp xs (foldl insertRefRes mp x)+        insertRefRes mp res@((fp,RefacModified), _) = Map.insert fp res mp+        insertRefRes mp _ = mp++-- | Take an ordered list of refactorings and apply them in order, threading the+-- state through all of them+threadState :: GM.Options -> RefactState -> [RefactGhc [ApplyRefacResult]]+            -> IO [([ApplyRefacResult], RefactState)]+threadState _ _ [] = return []+threadState opt currState (rGhc : rst) = do+  res@(_rGhcRes, newState) <- runRefactGhc rGhc currState opt+  let (Just modu) = rsModule newState+      newMod = modu {rsStreamModified = RefacUnmodifed}+      nextState = newState {rsModule = Just newMod }+  rest <- threadState opt nextState rst+  return (res : rest)++-- ---------------------------------------------------------------------++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@@ -216,19 +392,27 @@     canonicalizeTarget (Left path)     = Left <$> canonicalizePath (cur </> path)     canonicalizeTarget (Right modname) = return $ Right modname   mapM canonicalizeTarget tgts-+-} -- --------------------------------------------------------------------- -- TODO: the module should be stored in the state, and returned if it -- has been modified in a prior refactoring, instead of being parsed -- afresh each time.  -- | Apply a refactoring (or part of a refactoring) to a single module-applyRefac-    :: RefactGhc a       -- ^ The refactoring++applyRefac :: RefactGhc a -> RefacSource -> RefactGhc (ApplyRefacResult, a)+applyRefac = applyRefac' True -- TODO: applyRefac' is never called except from+                              -- here. Do we always need to clear the state on+                              -- completion?++applyRefac'+    ::+       Bool               -- ^ Boolean that determines if the state should be cleared+    -> RefactGhc a        -- ^ The refactoring     -> RefacSource        -- ^ where to get the module and toks     -> RefactGhc (ApplyRefacResult,a) -applyRefac refac source = do+applyRefac' clearSt refac source = do      -- TODO: currently a temporary, poor man's surrounding state     -- management: store state now, set it to fresh, run refac, then@@ -253,8 +437,9 @@     m    <- getRefactStreamModified      -- Clear the refactoring state-    clearParsedModule-+    if clearSt+      then clearParsedModule+      else return ()     absFileName <- liftIO $ canonicalizePath fileName     return (((absFileName,m),(anns, mod')),res) @@ -355,10 +540,11 @@      where        modifyFile ((fileName,_),(ann,parsed)) = do -           let rigidOptions :: PrintOptions Identity String-               rigidOptions = printOptions (\_ b -> return b) return return RigidLayout+           let+               -- rigidOptions :: PrintOptions Identity String+               -- rigidOptions = printOptions (\_ b -> return b) return return RigidLayout -               exactPrintRigid  ast as = runIdentity (exactPrintWithOptions rigidOptions ast as)+               -- exactPrintRigid  ast as = runIdentity (exactPrintWithOptions rigidOptions ast as)                exactPrintNormal ast as = runIdentity (exactPrintWithOptions stringOptions ast as)             -- let source = exactPrint parsed ann@@ -387,6 +573,7 @@  -- clientModsAndFiles :: GHC.ModuleName -> RefactGhc [TargetModule] clientModsAndFiles :: GM.ModulePath -> RefactGhc [TargetModule]+-- TODO: Use ghc-mod cache if there is a cabal file, else normal GHC modulegraph clientModsAndFiles m = do   mgs <- cabalModuleGraphs   -- logm $ "clientModsAndFiles:mgs=" ++ show mgs@@ -433,9 +620,10 @@ -- | Return the server module and file names. The server modules of -- module, say m, are those modules which are directly or indirectly -- imported by module m. This can only be called in a live GHC session--- TODO: make sure this works with multiple targets. Is that needed? No?+-- TODO: make sure this works with multiple targets. Is that needed? serverModsAndFiles   :: GHC.GhcMonad m => GHC.ModuleName -> m [GHC.ModSummary]+-- TODO: Use ghc-mod cache if there is a cabal file, else normal GHC modulegraph serverModsAndFiles m = do   ms <- GHC.getModuleGraph   modsum <- GHC.getModSummary m@@ -446,6 +634,13 @@    return serverMods +-- ---------------------------------------------------------------------+{-+-- | Finds all anotations that are contained within the given source span+lookupAnns :: Anns -> GHC.SrcSpan -> Anns+lookupAnns anns (GHC.RealSrcSpan span) = Map.filterWithKey isInSpan anns+  where isInSpan k@(AnnKey (GHC.RealSrcSpan annSpan) conN) v = GHC.containsSpan span annSpan+-} -- ---------------------------------------------------------------------  -- | In GHC 8 an error has an attached callstack. This is not always what we

@@ -18,19 +18,22 @@   , isClassName   , isInstanceName   , isDeclaredInRdr+   , FreeNames(..),DeclaredNames(..)   , hsFreeAndDeclaredRdr   , hsFreeAndDeclaredNameStrings   , hsFreeAndDeclaredPNs-  -- , hsFreeAndDeclaredGhc+   , getDeclaredTypesRdr   , getDeclaredVarsRdr-  , hsVisibleNamesRdr++  , hsVisibleNamesRdr, hsVisibleDsRdr   , hsFDsFromInsideRdr, hsFDNamesFromInsideRdr, hsFDNamesFromInsideRdrPure-  , hsVisibleDsRdr+   , rdrName2Name, rdrName2NamePure   , eqRdrNamePure   -- , rdrName2Name'+  , sameNameSpace    -- ** Identifiers, expressions, patterns and declarations   , FindEntity(..)@@ -40,7 +43,7 @@   , definedPNsRdr,definedNamesRdr   , definingDeclsRdrNames,definingDeclsRdrNames',definingSigsRdrNames   , definingTyClDeclsNames-  , definesRdr,definesDeclRdr+  , definesRdr,definesDeclRdr,definesNameRdr   , definesTypeSigRdr,definesSigDRdr    , hsTypeVbls@@ -54,7 +57,6 @@ import Data.List import Data.Maybe import Data.Monoid--- import Debug.Trace  import Language.Haskell.Refact.Utils.GhcVersionSpecific import Language.Haskell.Refact.Utils.LocUtils@@ -71,7 +73,7 @@ import qualified Bag           as GHC import qualified GHC           as GHC import qualified Name          as GHC-import qualified Outputable    as GHC+-- import qualified Outputable    as GHC import qualified RdrName       as GHC  import qualified Data.Generics as SYB@@ -246,40 +248,78 @@  -- --------------------------------------------------------------------- +-- |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+  (f,d) <- hsFreeAndDeclaredPNs t+  return ((nub.map showGhc) f, (nub.map showGhc) d)++-- ---------------------------------------------------------------------++-- | 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+  nm <- getRefactNameMap+  -- TODO: Change the return type to (FreeNames,DeclaredNames)+  let (FN f,DN d) = hsFreeAndDeclaredRdr nm 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.--- Expects RenamedSource+-- Expects ParsedSource hsFreeAndDeclaredRdr :: (SYB.Data t) => NameMap -> t -> (FreeNames,DeclaredNames) hsFreeAndDeclaredRdr nm t = res   where     fd = hsFreeAndDeclaredRdr' nm t-    (FN f,DN d) = fromMaybe mempty fd+    (FN f,DN d) = case fd of+      Left _err -> mempty+      Right v -> v     res = (FN (f \\ d),DN d) -hsFreeAndDeclaredRdr':: (SYB.Data t) => NameMap -> t -> Maybe (FreeNames,DeclaredNames)+hsFreeAndDeclaredRdr':: (SYB.Data t) => NameMap -> t -> Either String (FreeNames,DeclaredNames) hsFreeAndDeclaredRdr' nm t = do       (FN f,DN d) <- hsFreeAndDeclared'-      let (f',d') = (nub f, nub d)+      -- let (f',d') = ( filter (not . GHC.isTyVarName) $ nub f+      --               , filter (not . GHC.isTyVarName) $ nub d)+      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+          hsFreeAndDeclared' :: Either String (FreeNames,DeclaredNames)+          hsFreeAndDeclared'  = applyTU (stop_tdTU (failTU                                                       `adhocTU` expr                                                       `adhocTU` pat                                                       `adhocTU` bndrs                                                       `adhocTU` binds                                                       `adhocTU` bindList                                                       `adhocTU` match+                                                      `adhocTU` stmtlist                                                       `adhocTU` stmts                                                       `adhocTU` rhs                                                       `adhocTU` ltydecl+                                                      `adhocTU` tyvarbndrs+                                                      `adhocTU` lhstyvarbndr+#if __GLASGOW_HASKELL__ > 710+                                                      `adhocTU` lsigtype+#endif+                                                      `adhocTU` sig+                                                      `adhocTU` datadefn+                                                      `adhocTU` condecl+                                                      `adhocTU` condetails+                                                      `adhocTU` condeclfield                                                       `adhocTU` hstype                                                        )) t +           -- expr -- #if __GLASGOW_HASKELL__ <= 710           expr (GHC.L l (GHC.HsVar n))@@ -311,7 +351,7 @@ #else           expr (GHC.L _ (GHC.RecordCon ln _ _ e)) = do #endif-            fd <- (hsFreeAndDeclaredRdr' nm e)+            fd <- hsFreeAndDeclaredRdr' nm e             addFree (rdrName2NamePure nm ln) fd   --Need Testing            expr (GHC.L _ (GHC.EAsPat ln e)) = do@@ -329,7 +369,7 @@             -- pat ---          pat :: GHC.LPat GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          pat :: GHC.LPat GHC.RdrName -> Either String (FreeNames,DeclaredNames)           pat (GHC.L _ (GHC.WildPat _)) = mzero #if __GLASGOW_HASKELL__ <= 710           pat (GHC.L l (GHC.VarPat n))@@ -338,7 +378,7 @@ #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+            (f,DN d) <- hsFreeAndDeclaredRdr' nm p             return (f,DN (rdrName2NamePure nm ln:d))            pat (GHC.L _ (GHC.ParPat p)) = pat p@@ -396,9 +436,8 @@            -- --------------------------- -          details :: GHC.HsConPatDetails GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          details :: GHC.HsConPatDetails GHC.RdrName -> Either String (FreeNames,DeclaredNames)           details (GHC.PrefixCon  args) = do-            -- logm $ "hsFreeAndDeclaredGhc.details:args=" ++ (showGhc args)             fds <- mapM pat args             return $ mconcat fds           details (GHC.RecCon recf) =@@ -408,7 +447,7 @@             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 GHC.RdrName (GHC.LPat GHC.RdrName)) -> Either String (FreeNames,DeclaredNames)           recfields (GHC.HsRecFields fields _) = do             let args = map (\(GHC.L _ (GHC.HsRecField _ arg _)) -> arg) fields             fds <- mapM pat args@@ -417,12 +456,12 @@           -- -----------------------  #if __GLASGOW_HASKELL__ <= 710-          bndrs :: GHC.HsWithBndrs GHC.RdrName (GHC.LHsType GHC.RdrName) -> Maybe (FreeNames,DeclaredNames)+          bndrs :: GHC.HsWithBndrs GHC.RdrName (GHC.LHsType GHC.RdrName) -> Either String (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.LHsSigWcType GHC.RdrName -> Either String (FreeNames,DeclaredNames)           bndrs (GHC.HsIB _ (GHC.HsWC _ _ ty)) = do             (FN ft,DN _dt) <- hsFreeAndDeclaredRdr' nm ty             -- return (FN dt,DN [])@@ -461,6 +500,13 @@               (FN rf,DN rd) <- hsFreeAndDeclaredRdr' nm mrhs               return (FN (pf `union` (rf \\ (pd `union` rd))),DN []) +          stmtlist (ds :: [GHC.ExprLStmt GHC.RdrName]) = do+            (FN f,DN d) <- recurseList ds+            -- unless (null ds) $ do+            --   -- error $ "hsFreeAndDeclaredRdr'.stmtlist ds=" ++ showGhc ds+            --   error $ "hsFreeAndDeclaredRdr'.stmtlist (f,d)=" ++ showGhc (f,d)+            return (FN (f\\d),DN d)+           -- stmts -- #if __GLASGOW_HASKELL__ <= 710           stmts ((GHC.BindStmt pat' expre _bindOp _failOp) :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) = do@@ -470,9 +516,10 @@             -- TODO ++AZ++ : Not sure it is meaningful to pull             --               anything out of bindOp/failOp             (FN pf,DN pd)  <- hsFreeAndDeclaredRdr' nm pat'+            -- error $ "hsFreeAndDeclaredRdr'.stmts.BindStmt (pf,pd)=" ++ showGhc (pf,pd)             (FN ef,_ed) <- hsFreeAndDeclaredRdr' nm expre             let sf1 = []-            return (FN $ pf `union` ef `union` (sf1\\pd),DN []) -- pd) -- Check this+            return (FN $ pf `union` ef `union` (sf1\\pd),DN pd) -- pd) -- Check this            stmts ((GHC.LetStmt binds') :: GHC.Stmt GHC.RdrName (GHC.LHsExpr GHC.RdrName)) =             hsFreeAndDeclaredRdr' nm binds'@@ -481,30 +528,171 @@            -- tycldecls ----------------- -          ltydecl :: GHC.TyClDecl GHC.RdrName -> Maybe (FreeNames,DeclaredNames)+          ltydecl :: GHC.TyClDecl GHC.RdrName -> Either String (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+          ltydecl (GHC.DataDecl ln tyvars 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+          ltydecl (GHC.DataDecl ln tyvars defn _c _fvs) = do #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)+              (FN fs,DN dds) <- hsFreeAndDeclaredRdr' nm  defn+              (FN _ft,DN dt) <- hsFreeAndDeclaredRdr' nm  tyvars+              return (FN (fs \\ dt),DN (rdrName2NamePure nm ln:dds))+          ltydecl (GHC.ClassDecl ctx ln tyvars+                           _fds sigs meths ats atds _docs _fvs) = do+             ct  <- hsFreeAndDeclaredRdr' nm ctx+             (_,DN tv)  <- hsFreeAndDeclaredRdr' nm tyvars+             ss  <- recurseList sigs+             md  <- hsFreeAndDeclaredRdr' nm meths+             ad  <- hsFreeAndDeclaredRdr' nm ats+             atd <- hsFreeAndDeclaredRdr' nm atds+             let (FN ff,DN df) = ((FN [],DN [rdrName2NamePure nm ln]) <> md <> ad <> atd <> ct <> ss)+             return (FN (nub ff \\ tv), DN df)            ------------------------------ -          hstype :: GHC.LHsType GHC.RdrName -> Maybe (FreeNames,DeclaredNames) #if __GLASGOW_HASKELL__ <= 710+          tyvarbndrs :: GHC.LHsTyVarBndrs GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          tyvarbndrs (GHC.HsQTvs _implicit explicit) = do+            recurseList explicit+#else+          tyvarbndrs :: GHC.LHsQTyVars GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          tyvarbndrs (GHC.HsQTvs _implicit explicit _dependent ) = recurseList explicit+#endif++          lhstyvarbndr :: GHC.LHsTyVarBndr GHC.RdrName -> Either String (FreeNames,DeclaredNames)+#if __GLASGOW_HASKELL__ <= 710+          lhstyvarbndr (GHC.L l (GHC.UserTyVar n)) = return (FN [], DN [rdrName2NamePure nm (GHC.L l n)])+#else+          lhstyvarbndr (GHC.L _ (GHC.UserTyVar ln)) = return (FN [], DN [rdrName2NamePure nm ln])+#endif+          lhstyvarbndr (GHC.L _ (GHC.KindedTyVar ln lk)) = do+            ks <- hsFreeAndDeclaredRdr' nm lk+            return ((FN [], DN [rdrName2NamePure nm ln]) <> ks)++          ------------------------------++#if __GLASGOW_HASKELL__ > 710+          lsigtype :: GHC.LHsSigType GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          lsigtype (GHC.HsIB _ typ) = do+            hsFreeAndDeclaredRdr' nm typ+#endif++          ------------------------------++          sig :: GHC.Sig GHC.RdrName -> Either String (FreeNames,DeclaredNames)+#if __GLASGOW_HASKELL__ <= 710+          sig (GHC.TypeSig lns typ _) = do+#else+          sig (GHC.TypeSig lns typ) = do+#endif+            (FN ft, dt) <- hsFreeAndDeclaredRdr' nm typ+            -- error $ "sig:ft=" ++ (intercalate "," $ map (\n -> showGhc n ++ (occAttributes $ GHC.occName n)) ft)+            return ((FN [],DN (map (rdrName2NamePure nm ) lns))+                     <> (FN (filter (not . GHC.isTyVarName) ft), dt))+#if __GLASGOW_HASKELL__ <= 710+          sig (GHC.PatSynSig ln (_ef,GHC.HsQTvs _ns bndrs) ctx1 ctx2 typ) = do+            (_, DN bs) <- hsFreeAndDeclaredRdr' nm bndrs+            c1s <- hsFreeAndDeclaredRdr' nm ctx1+            c2s <- hsFreeAndDeclaredRdr' nm ctx2+            ts  <- hsFreeAndDeclaredRdr' nm typ+            let (FN f,DN d) = c1s <> c2s <> ts+                fd = (FN (f \\ bs), DN d )+            return ((FN [],DN [rdrName2NamePure nm ln]) <> fd)+#else+          sig (GHC.PatSynSig ln typ) = do+            ts <- hsFreeAndDeclaredRdr' nm typ+            return ((FN [],DN [rdrName2NamePure nm ln]) <> ts)+#endif+#if __GLASGOW_HASKELL__ <= 710+          sig (GHC.GenericSig lns typ) = do+#else+          sig (GHC.ClassOpSig _ lns typ) = do+#endif+            ts <- hsFreeAndDeclaredRdr' nm typ+            return ((FN [],DN (map (rdrName2NamePure nm) lns)) <> ts)+          sig (GHC.IdSig _ ) = error $ "hsFreeAndDeclaredRdr:IdSig should not occur"+          sig (GHC.FixSig fsig) = hsFreeAndDeclaredRdr' nm fsig+          sig (GHC.InlineSig ln _) = do+            return ((FN [],DN [rdrName2NamePure nm ln]) )+          sig (GHC.SpecSig ln typs _) = do+            ts <- recurseList typs+            return ((FN [rdrName2NamePure nm ln],DN []) <> ts)+          sig (GHC.SpecInstSig _ ssig) = hsFreeAndDeclaredRdr' nm ssig+          sig (GHC.MinimalSig _ _) = return mempty++          ------------------------------++          datadefn :: GHC.HsDataDefn GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          datadefn (GHC.HsDataDefn _ ctxt mtyp mkind cons mderivs) = do+             cts <- mapM (hsFreeAndDeclaredRdr' nm) $ GHC.unLoc ctxt+             ts  <- maybeHelper mtyp+             ks  <- maybeHelper mkind+             cs  <- mapM (hsFreeAndDeclaredRdr' nm) cons+             ds  <- case mderivs of+                      Nothing           -> return (FN [],DN [])+                      Just (GHC.L _ ds) -> recurseList ds+             -- error $ "hit datadefn:[cts,ts,ks,cs,ds]=" ++ show (cts++ [ts,ks,ds] ++ cs)+             return $ mconcat [mconcat cts,ts,ks,mconcat cs,ds]++          ------------------------------++          condecl :: GHC.LConDecl GHC.RdrName -> Either String (FreeNames,DeclaredNames)+#if __GLASGOW_HASKELL__ <= 710+          condecl (GHC.L _ (GHC.ConDecl ns _expr (GHC.HsQTvs _ns bndrs) ctxt+                                        dets res _ depc_syntax)) =+            case res of+              GHC.ResTyGADT ls typ -> do+                (ft,_) <- hsFreeAndDeclaredRdr' nm typ+                return (ft,DN (map (rdrName2NamePure nm) ns))+              GHC.ResTyH98 -> do+                cs <- hsFreeAndDeclaredRdr' nm ctxt+                ds <- hsFreeAndDeclaredRdr' nm dets+                return ((FN [], DN (map (rdrName2NamePure nm) ns)) <> cs <> ds)+#else+          condecl (GHC.L _ (GHC.ConDeclGADT ns typ _)) = do+            (ft,_) <- hsFreeAndDeclaredRdr' nm typ+            return (ft,DN (map (rdrName2NamePure nm) ns))+          condecl (GHC.L _ (GHC.ConDeclH98 n _ mctxt dets _)) = do+             cs <- maybeHelper mctxt+             ds <- hsFreeAndDeclaredRdr' nm dets+             return ((FN [], DN ([rdrName2NamePure nm n])) <> cs <> ds)+#endif++          ------------------------------++          -- condetails :: GHC.HsConDetails (GHC.LBangType GHC.RdrName) (GHC.Located [GHC.LConDeclField GHC.RdrName])+          condetails :: GHC.HsConDeclDetails GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          condetails (GHC.PrefixCon args)      = do+            -- TODO: get rid of the tyvars+            (FN fs,d) <- recurseList args+            return (FN (filter (not . GHC.isTyVarName) fs),d)+          condetails (GHC.RecCon (GHC.L _ fs)) = recurseList fs+          condetails (GHC.InfixCon a1 a2)      = do+            -- TODO: get rid of the tyvars+            (FN fs,d) <- recurseList [a1,a2]+            return (FN (filter (not . GHC.isTyVarName) fs),d)++          ------------------------------++          condeclfield :: GHC.LConDeclField GHC.RdrName -> Either String (FreeNames,DeclaredNames)+          condeclfield (GHC.L _ (GHC.ConDeclField fns typ _)) = do+#if __GLASGOW_HASKELL__ <= 710+            let ns = fns+#else+            let ns = map (GHC.rdrNameFieldOcc . GHC.unLoc) fns+#endif+            dt <- hsFreeAndDeclaredRdr' nm typ+            return ((FN [],DN (map (rdrName2NamePure nm) ns)) <> dt)++          ------------------------------++          hstype :: GHC.LHsType GHC.RdrName -> Either String (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@@ -539,10 +727,10 @@           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"+          hstype (GHC.L _ (GHC.HsWildcardTy)) = return (FN [],DN [])+          hstype (GHC.L l (GHC.HsNamedWildcardTy n)) = return (FN [rdrName2NamePure nm (GHC.L l n)],DN []) #else-          hstype (GHC.L _ (GHC.HsWildCardTy _)) = error "To implement: hstype, HsWildcardTy"+          hstype (GHC.L _ (GHC.HsWildCardTy _)) = return (FN [],DN []) #endif #if __GLASGOW_HASKELL__ > 710           hstype (GHC.L _ (GHC.HsQualTy (GHC.L _ ctxt) ty)) = recurseList (ty:ctxt)@@ -560,41 +748,17 @@             fds <- mapM (hsFreeAndDeclaredRdr' nm) xs             return $ mconcat fds +          maybeHelper mv = case mv of+            Nothing -> return (FN [], DN [])+            Just v -> hsFreeAndDeclaredRdr' nm v+           ------------------------------            addFree :: GHC.Name -> (FreeNames,DeclaredNames)-                  -> Maybe (FreeNames,DeclaredNames)+                  -> Either String (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@@ -700,19 +864,19 @@ -- |Find those declarations(function\/pattern binding) which define -- the specified GHC.Names. incTypeSig indicates whether the -- corresponding type signature will be included.-definingDeclsRdrNames::+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+            -> [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+-- TODO: Maybe Use hsFreeAndDeclaredRdr to see what is declared in a decl. Recursive?   where    defining decl      = if recursive-        then SYB.everythingStaged SYB.Parser (++) [] ([]  `SYB.mkQ` definesDecl `SYB.extQ` definesBind)  decl+        then SYB.everything  (++) ([]  `SYB.mkQ` definesDecl `SYB.extQ` definesBind)  decl         else definesDecl decl      where       definesDecl :: (GHC.LHsDecl GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]@@ -726,6 +890,12 @@       definesDecl decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))         | any (\n -> definesDeclRdr nameMap n decl') pns = [decl'] +      definesDecl decl'@(GHC.L _l (GHC.TyClD _))+        | any (\n -> definesNameRdr nameMap n decl') pns = [decl']++      definesDecl decl'@(GHC.L _l (GHC.SigD _))+        | incTypeSig && any (\n -> definesNameRdr nameMap n decl') pns = [decl']+       definesDecl _ = []        definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]@@ -753,6 +923,9 @@       defines' decl'@(GHC.L _l (GHC.ValD (GHC.PatBind _p _rhs _ty _fvs _)))         | any (\n -> definesDeclRdr nameMap n decl') pns = [decl'] +      defines' decl'@(GHC.L _l (GHC.TyClD _))+        | any (\n -> definesDeclRdr nameMap n decl') pns = [decl']+       defines' _ = []        definesBind :: (GHC.LHsBind GHC.RdrName) -> [GHC.LHsDecl GHC.RdrName]@@ -803,7 +976,7 @@             => NameMap             -> [GHC.Name]   -- ^ The specified identifiers.             -> t -- ^ A collection of declarations.-            ->[GHC.LTyClDecl GHC.RdrName]  -- ^ The result.+            -> [GHC.LTyClDecl GHC.RdrName]  -- ^ The result. definingTyClDeclsNames nm pns t = defining t   where    defining decl@@ -825,12 +998,16 @@         | otherwise = []  #if __GLASGOW_HASKELL__ <= 710-      defines' decl'@(GHC.L _ (GHC.DataDecl pname _ _ _))+      defines' decl'@(GHC.L _ (GHC.DataDecl _ _ _ _)) #else-      defines' decl'@(GHC.L _ (GHC.DataDecl pname _ _ _ _))+      defines' decl'@(GHC.L _ (GHC.DataDecl _ _ _ _ _)) #endif-        | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        --   elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']+        | not $ null (dus `intersect` uns) = [decl']         | otherwise = []+        where+          (_,DN ds) = hsFreeAndDeclaredRdr nm decl'+          dus = map GHC.nameUnique ds        defines' decl'@(GHC.L _ (GHC.ClassDecl _ pname _ _ _ _ _ _ _ _))         | elem (GHC.nameUnique $ rdrName2NamePure nm pname) uns = [decl']@@ -856,11 +1033,30 @@   = elem n (map (rdrName2NamePure nm) (hsNamessRdr p)) definesRdr _ _ _= False --- |Unwraps a LHsDecl and calls definesRdr on the result if a HsBind++-- |Unwraps a LHsDecl and calls definesRdr on the result if a HsBind or calls clsDeclDefinesRdr if a TyClD 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 nameMap nin (GHC.L _ (GHC.TyClD ty)) = clsDeclDefinesRdr nameMap nin ty definesDeclRdr _ _ _ = False +-- | Return True of the type class declaration defines the+-- specified identifier+clsDeclDefinesRdr :: NameMap -> GHC.Name -> GHC.TyClDecl GHC.RdrName -> Bool+clsDeclDefinesRdr nameMap nin (GHC.SynDecl (GHC.L ln _nm) _ty _rhs _) =+  case Map.lookup ln nameMap of+    Nothing -> False+    Just n  -> GHC.nameUnique n == GHC.nameUnique nin+clsDeclDefinesRdr _ _ _ = False++-- | Returns True if the provided Name is defined in the LHsDecl+definesNameRdr :: NameMap -> GHC.Name -> GHC.LHsDecl GHC.RdrName -> Bool+definesNameRdr nameMap nin (GHC.L l (GHC.ValD d))  = definesRdr nameMap nin (GHC.L l d)+definesNameRdr nameMap nin d = nin `elem` declared+  where+    (_,DN declared) = hsFreeAndDeclaredRdr nameMap d+-- definesDeclRdr _ _ _ = False+ -- ---------------------------------------------------------------------  -- | Return True if the declaration defines the type signature of the@@ -940,6 +1136,8 @@ -- return []. hsVisibleDsRdr :: (SYB.Data t)              => NameMap -> GHC.Name -> t -> RefactGhc DeclaredNames+-- TODO: DeclaredNames is probably the wrong type. Perhaps create VisibleNames+--       And perhaps use a NameSet or Set, to avoid the nub call hsVisibleDsRdr nm e t = do   -- logm $ "hsVisibleDsRdr:(e,t)=" ++ (SYB.showData SYB.Renamer 0 (e,t))   (DN d) <- res@@ -950,6 +1148,7 @@     --       in terms of sub-elements. Hence as an optimisation,     --       consider calling the relevent element directly, instead     --       of looping back into the main function.+    --  OR, use a more effective recursion scheme     res = (const err -- (DN [])           `SYB.extQ` parsed           `SYB.extQ` lvalbinds@@ -961,6 +1160,7 @@           `SYB.extQ` hsbind           `SYB.extQ` hslocalbinds           `SYB.extQ` lmatch+          `SYB.extQ` match           `SYB.extQ` grhss           `SYB.extQ` lgrhs           `SYB.extQ` lexpr@@ -968,7 +1168,10 @@           `SYB.extQ` tyclgroup           `SYB.extQ` tycldeclss           `SYB.extQ` tycldecls+          `SYB.extQ` ltycldecl           `SYB.extQ` tycldecl+          `SYB.extQ` hsdatadefn+          `SYB.extQ` condecl           `SYB.extQ` instdecls           `SYB.extQ` instdecl           `SYB.extQ` lhstype@@ -982,6 +1185,7 @@           `SYB.extQ` ibndrs           `SYB.extQ` lsigty #endif+          `SYB.extQ` lanndecl           ) t      -- err2 = error $ "hsVisibleDsRdr:err2:no match for:" ++ (SYB.showData SYB.Renamer 0 t)@@ -990,9 +1194,9 @@     parsed p       | findNameInRdr nm e p = do          -- dfds <- mapM (hsVisibleDsRdr nm e) $ GHC.hsmodDecls $ GHC.unLoc p-         logm $ "hsVisibleDsRdr parsedSource:decls starting"+         -- logm $ "hsVisibleDsRdr parsedSource:decls starting"          dfds <- mapM (declFun ( hsVisibleDsRdr nm e) ) $ GHC.hsmodDecls $ GHC.unLoc p-         logm $ "hsVisibleDsRdr parsedSource:decls done"+         -- logm $ "hsVisibleDsRdr parsedSource:decls done"          return $ mconcat dfds     parsed _ = return (DN []) @@ -1009,11 +1213,11 @@           return $ mconcat fdss <> mconcat fdsb     valbinds vb@(GHC.ValBindsOut _binds _sigs)       | findNameInRdr nm e vb = do-          logm $ "hsVisibleDsRdr valbinds:ValBindsOut:impossible for RdrName"+          -- logm $ "hsVisibleDsRdr valbinds:ValBindsOut:impossible for RdrName"           return (DN [])      valbinds _ = do-      logm $ "hsVisibleDsRdr nm.valbinds:not matched"+      -- logm $ "hsVisibleDsRdr nm.valbinds:not matched"       return (DN [])      lhsdecls :: [GHC.LHsDecl GHC.RdrName] -> RefactGhc DeclaredNames@@ -1025,7 +1229,7 @@      lhsdecl :: GHC.LHsDecl GHC.RdrName -> RefactGhc DeclaredNames     lhsdecl (GHC.L l dd) = do-        logm $ "hsVisibleDsRdr.lhsdecl"+        -- 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)@@ -1065,10 +1269,8 @@ #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 [])  @@ -1081,35 +1283,41 @@     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+    lmatch (GHC.L _ m) = match m++    match :: (GHC.Match GHC.RdrName (GHC.LHsExpr GHC.RdrName)) -> RefactGhc DeclaredNames+    match (GHC.Match _fn pats _mtyp rhs)+      | findNameInRdr nm e rhs || findNameInRdr nm e pats = 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+           -- logm $ "hsVisibleDsRdr nm.lmatch:rd=" ++ (show rd)            return (pd <> rd)-    lmatch _ =return  (DN [])+    match _ =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"+      | findNameInRdr nm e guardedRhss || findNameInRdr nm e lstmts' = do+          -- logm "hsVisibleDsRdr nm.grhss:about to do lstmts"           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 [])+          -- sfds <- hsVisibleDsRdr nm e lstmts'+          let (_,sfds) = hsFreeAndDeclaredRdr nm lstmts'+          return $ mconcat (sfds:fds)+    grhss _ = do+      -- logm $ "hsVisibleDsRdr.grhss: no match"+      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 [])+      | findNameInRdr nm e guards = hsVisibleDsRdr nm e guards+      | findNameInRdr nm e ex     = do+        r <- hsVisibleDsRdr nm e ex+        -- logm $ "hsVisibleDsRdr.lgrhs:r=" ++ show r+        return r+    lgrhs _ = do+      -- logm $ "hsVisibleDsRdr.lgrhs: no match"+      return (DN [])       lexpr :: GHC.LHsExpr GHC.RdrName -> RefactGhc DeclaredNames@@ -1119,26 +1327,25 @@     lexpr (GHC.L l (GHC.HsVar (GHC.L _ n))) #endif       | findNameInRdr nm e n  = do-        logm $ "hsVisibleDsRdr.lexpr.HsVar entity found"+        -- 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"+        -- 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+        -- logm $ "hsVisibleDsRdr nm.lexpr.(e,expr):" ++ (showGhc (e,expr))+        let (FN efs,eds)         = 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))+        -- logm $ "hsVisibleDsRdr nm.lexpr (efs,_d,_eefs,eeds) " ++ show (efs,_d,_eefs,eeds)+        return (DN (efs \\ eeds) <> eds)      lexpr x = do-      logm $ "hsVisibleDsRdr.lexpr:miss for:" ++ SYB.showData SYB.Parser 0 x+      -- logm $ "hsVisibleDsRdr.lexpr:miss for:" ++ SYB.showData SYB.Parser 0 x       return (DN [])      -- ---------------------------------@@ -1167,21 +1374,38 @@     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+    ltycldecl :: GHC.LTyClDecl GHC.RdrName -> RefactGhc DeclaredNames+    ltycldecl tcd+      | findNameInRdr nm e tcd = do+        let (_,ds) = hsFreeAndDeclaredRdr nm tcd+        return ds+    ltycldecl _ = return (DN [])++    tycldecl :: GHC.TyClDecl 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 []) +    hsdatadefn :: GHC.HsDataDefn GHC.RdrName -> RefactGhc DeclaredNames+    hsdatadefn tcd+      | findNameInRdr nm e tcd = do+        let (_,ds) = hsFreeAndDeclaredRdr nm tcd+        return ds+    hsdatadefn _ = return (DN [])++    condecl :: GHC.ConDecl GHC.RdrName -> RefactGhc DeclaredNames+    condecl tcd+      | findNameInRdr nm e tcd = do+        let (_,ds) = hsFreeAndDeclaredRdr nm tcd+        return ds+    condecl _ = return (DN [])+     -- ---------------------------------      instdecls :: [GHC.LInstDecl GHC.RdrName] -> RefactGhc DeclaredNames@@ -1219,7 +1443,7 @@         = return (DN [])     lhstype (GHC.L _ (GHC.HsFunTy{})) = return (DN [])     lhstype ty = do-      logm $ "lshtype: TypeUtils 1588" ++ SYB.showData SYB.Renamer 0 ty+      -- logm $ "lshtype: TypeUtils 1588" ++ SYB.showData SYB.Renamer 0 ty       return (DN [])      -- -----------------------@@ -1342,7 +1566,6 @@       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 )@@ -1382,7 +1605,6 @@      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) =@@ -1407,6 +1629,9 @@     lsigty (GHC.HsIB _ ty) = hsVisibleDsRdr nm e ty #endif     -- -----------------------+    lanndecl :: GHC.LAnnDecl GHC.RdrName -> RefactGhc DeclaredNames+    lanndecl (GHC.L _ (GHC.HsAnnotation _ _ expr)) = hsVisibleDsRdr nm e expr+    -- -----------------------      err = error $ "hsVisibleDsRdr nm:no match for:" ++ (SYB.showData SYB.Parser 0 t) @@ -1549,6 +1774,13 @@ eqRdrNamePure :: NameMap -> GHC.Located GHC.RdrName -> GHC.Name -> Bool eqRdrNamePure nameMap rn n   = GHC.nameUnique (rdrName2NamePure nameMap rn) == GHC.nameUnique n++-- ---------------------------------------------------------------------++-- | Returns True if both @GHC.Name@s are in the same @GHC.NameSpace@.+sameNameSpace :: GHC.Name -> GHC.Name -> Bool+sameNameSpace n1 n2+  = (GHC.occNameSpace $ GHC.nameOccName n1) == (GHC.occNameSpace $ GHC.nameOccName n2)  -- --------------------------------------------------------------------- 

@@ -1,312 +0,0 @@-{-# 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---- temporary until exposed by ghc-mod--- import           Options-import           Language.Haskell.GhcMod.Options.Options--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--              addCommand "dupdef"-                         "Duplicate a definition"-                         runCmd-                         dupDefCmdOpts--              addCommand "iftocase"-                         "Convert an if statement to a case statement"-                         runCmd-                         ifToCaseCmdOpts--              addCommand "liftOneLevel"-                         "Lift a definition up one level"-                         runCmd-                         liftOneLevelCmdOpts--              addCommand "liftToTopLevel"-                         "Lift a definition to the top level"-                         runCmd-                         liftToTopLevelCmdOpts--              addCommand "rename"-                         "Rename an identifier"-                         runCmd-                         renameCmdOpts--              addCommand "addOneParam"-                         "Add a new parameter to a function in first position"-                         runCmd-                         addOneParamCmdOpts--              addCommand "rmOneParam"-                         "Remove a new parameter from a function"-                         runCmd-                         rmOneParamCmdOpts-    run global---- -----------------------------------------------------------------------type Row = Int-type Col = Int--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--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)--runCmd (IfToCaseCmd fileName sr sc er ec) (opt, gOpt)-  = runFunc $ ifToCase opt gOpt fileName (sr,sc) (er,ec)--runCmd (LiftOneLevel fileName r c) (opt, gOpt)-  = runFunc $ liftOneLevel opt gOpt fileName (r,c)--runCmd (LiftToTopLevel fileName r c) (opt, gOpt)-  = runFunc $ liftToTopLevel opt gOpt fileName (r,c)--runCmd (RenameCmd fileName newname r c) (opt, gOpt)-  = runFunc $ rename opt gOpt fileName newname (r,c)--runCmd (AddOneParam fileName newname r c) (opt, gOpt)-  = runFunc $ addOneParameter opt gOpt fileName newname (r,c)--runCmd (RmOneParam fileName r c) (opt, gOpt)-  = runFunc $ rmOneParameter opt gOpt fileName (r,c)---- -----------------------------------------------------------------------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")---- -----------------------------------------------------------------------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")---- -----------------------------------------------------------------------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-  let ret = case r of-       Left s    -> "(error " ++ (show s) ++ ")"-       Right mfs -> "(ok " ++ showLisp mfs ++ ")"-  putStrLn ret--showLisp :: [String] -> String-showLisp xs = "(" ++ (intercalate " " $ map show xs) ++ ")"--catchException :: (IO t) -> IO (Either String t)-catchException f = do-  res <- handle handler (f >>= \r -> return $ Right r)-  return res-  where-    handler:: SomeException -> IO (Either String t)-    handler e = return (Left (stripCallStack $ show e))

@@ -56,8 +56,7 @@       r' `shouldBe` ["Case/C.hs"]       diff <- compareFiles "./test/testdata/Case/C.refactored.hs"                            "./test/testdata/Case/C.hs.expected"-      -- diff `shouldBe` []-      pendingWith "sort out alignment after RigidLayout introduced in ghc-exactprint"+      diff `shouldBe` []      -- --------------------------------- @@ -68,8 +67,7 @@       r' `shouldBe` ["Case/D.hs"]       diff <- compareFiles "./test/testdata/Case/D.refactored.hs"                            "./test/testdata/Case/D.hs.expected"-      -- diff `shouldBe` []-      pendingWith "sort out alignment after RigidLayout introduced in ghc-exactprint"+      diff `shouldBe` []      -- --------------------------------- @@ -80,8 +78,7 @@       r' `shouldBe` ["Case/E.hs"]       diff <- compareFiles "./test/testdata/Case/E.refactored.hs"                            "./test/testdata/Case/E.hs.expected"-      -- diff `shouldBe` []-      pendingWith "sort out alignment after RigidLayout introduced in ghc-exactprint"+      diff `shouldBe` []      -- --------------------------------- @@ -92,8 +89,7 @@       r' `shouldBe` ["Case/F.hs"]       diff <- compareFiles "./test/testdata/Case/F.refactored.hs"                            "./test/testdata/Case/F.hs.expected"-      -- diff `shouldBe` []-      pendingWith "sort out alignment after RigidLayout introduced in ghc-exactprint"+      diff `shouldBe` []     -- --------------------------------- 

@@ -0,0 +1,41 @@+module DeleteDefSpec (main, spec) where+++import Test.Hspec+import Language.Haskell.Refact.Refactoring.DeleteDef+import System.Directory+import TestUtils++main :: IO ()+main = do+  hspec spec++spec :: Spec+spec = do+  describe "doDeleteDef" $ do+    it "removes a small definition from the top level of a function" $ do+      res <- ct $ deleteDef defaultTestSettings testOptions "./DeleteDef/Dd1.hs"  (5,1)+      res' <- ct $ mapM makeRelativeToCurrentDirectory res+      res' `shouldBe` ["DeleteDef/Dd1.hs"]+      diff <- ct $ compareFiles "./DeleteDef/Dd1.refactored.hs"+                                "./DeleteDef/Dd1.hs.expected"+      diff `shouldBe` []+    it "checks that a definition used in another module is not deleted" $ do+      res <- ct $ catchException (deleteDef defaultTestSettings testOptions "./DeleteDef/Dd2.hs" (4,1))+      (show res) `shouldBe` "Just \"The def to be deleted is still being used\""+    it "checks that a definition used in the same module is not deleted" $ do+      res <- ct $ catchException (deleteDef defaultTestSettings testOptions "./DeleteDef/Dd3.hs" (4,1))+      (show res) `shouldBe` "Just \"The def to be deleted is still being used\""+    it "checks that a recursive definition can be deleted" $ do+      res <- ct $ deleteDef defaultTestSettings testOptions "./DeleteDef/Dd1.hs" (21,1)+      res' <- ct $ mapM makeRelativeToCurrentDirectory res+      res' `shouldBe` ["DeleteDef/Dd1.hs"]+      diff <- ct $ compareFiles "./DeleteDef/Dd1.refactored.hs"+                           "./DeleteDef/Dd1.hs.expected2"+      diff `shouldBe` []+    it "checks possible bug found by tests in unwrap type synonym" $ do+      res <- ct $ deleteDef defaultTestSettings testOptions "./DeleteDef/UTS1.hs" (3,6)+      res' <- ct $ mapM makeRelativeToCurrentDirectory res+      res' `shouldBe` ["DeleteDef/UTS1.hs"]+      diff <- ct $ compareFiles "./DeleteDef/UTS1.hs.expected" "./DeleteDef/UTS1.refactored.hs"+      diff `shouldBe` []

@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad+import TestUtils+import qualified Turtle as Tu+import qualified Control.Foldl as Fold++import Test.Hspec.Runner+import qualified Spec++-- ---------------------------------------------------------------------++main :: IO ()+main = do+  cleanupDirs (Tu.ends "/.stack-work")+  cleanupDirs (Tu.ends "/dist")+  setupStackFiles+  hspec Spec.spec++-- ---------------------------------------------------------------------++setupStackFiles :: IO ()+setupStackFiles =+  forM_ stackFiles $ \f ->+    writeFile f stackFileContents++-- ---------------------------------------------------------------------++stackFiles :: [FilePath]+stackFiles =+  [  "./test/testdata/stack.yaml"+   , "./test/testdata/cabal/cabal3/stack.yaml"+   , "./test/testdata/cabal/foo/stack.yaml"+   , "./test/testdata/cabal/cabal4/stack.yaml"+   , "./test/testdata/cabal/cabal1/stack.yaml"+   , "./test/testdata/cabal/cabal2/stack.yaml"+  ]+++-- |Choose a resolver based on the current compiler, otherwise HaRe/ghc-mod will+-- not be able to load the files+resolver :: String+resolver =+#if __GLASGOW_HASKELL__ > 710+  "resolver: nightly-2016-08-25"+#else+  "resolver: lts-6.13"+#endif++-- ---------------------------------------------------------------------+{-++resolver: lts-6.13+# resolver: nightly-2016-08-25+packages:+- '.'+extra-deps: []+-}+stackFileContents :: String+stackFileContents = unlines+  [ "# WARNING: THIS FILE IS AUTOGENERATED IN test/Main.hs. IT WILL BE OVERWRITTEN ON EVERY TEST RUN"+  , resolver+  , "packages:"+  , "- '.'"+  , "extra-deps: "+  , "- conversion-1.2.1"+  , "- conversion-bytestring-1.0.1"+  , "- conversion-case-insensitive-1.0.0.0"+  , "- conversion-text-1.0.1"+  ]++-- ---------------------------------------------------------------------++cleanupDirs :: Tu.Pattern t -> IO ()+cleanupDirs ending = do+  dirs <- getDirs ending+  forM_ dirs  $ \dir -> Tu.rmtree dir++getDirs :: Tu.Pattern t -> IO [Tu.FilePath]+getDirs ending = do+  let+    -- dirs = Tu.find (Tu.ends "/.stack-work") "./test"+    dirs = Tu.find ending "./test"+  Tu.fold dirs Fold.list++listStackDirs :: IO ()+listStackDirs = Tu.sh $ do+  dirs <- Tu.find (Tu.ends "/.stack-work") "./test"+  mapM Tu.echo $ Tu.textToLines $ "found:" Tu.<> (Tu.repr dirs)+

@@ -20,7 +20,7 @@    describe "liftToTopLevel" $ do     it "cannot lift a top level declaration" $ do-     -- res <- catchException (liftToTopLevel logTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (4,1))+     -- res <- catchException (ct $ liftToTopLevel logTestSettings testOptions "./MoveDef/Md1.hs" (4,1))      res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./MoveDef/Md1.hs" (4,1))      (show res) `shouldBe` "Just \"\\nThe identifier is not a local function/pattern name!\"" @@ -28,8 +28,8 @@      it "checks for name clashes" $ do      -- res <- catchException (doLiftToTopLevel ["./test/testdata/MoveDef/Md1.hs","17","5"])-     res <- catchException (liftToTopLevel defaultTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (17,5))-     (show res) `shouldBe` "Just \"The identifier(s): (ff, test/testdata/MoveDef/Md1.hs:17:5) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""+     res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./MoveDef/Md1.hs" (17,5))+     (show res) `shouldBe` "Just \"The identifier(s): (ff, MoveDef/Md1.hs:17:5) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""      {-     it "checks for invalid new name" $ do@@ -44,8 +44,8 @@     -- ---------------------------------      it "lifts a definition to the top level" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (24,5)-     -- r <- liftToTopLevel logTestSettings testOptions  "./test/testdata/MoveDef/Md1.hs" (24,5)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./MoveDef/Md1.hs" (24,5)+     -- r <- ct $ liftToTopLevel logTestSettings testOptions  "./test/testdata/MoveDef/Md1.hs" (24,5)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/MoveDef/Md1.hs\"]"      diff <- compareFiles "./test/testdata/MoveDef/Md1.hs.expected"@@ -92,7 +92,7 @@     -- ---------------------------------      it "liftToTopLevel D3 C3 A3 8 6" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/D3.hs" (8,6)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/D3.hs" (8,6)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/D3.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/D3.hs.expected"@@ -109,8 +109,8 @@     -- ---------------------------------      it "liftToTopLevel WhereIn1 12 18" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/WhereIn1.hs" (12,18)-     -- r <- liftToTopLevel logTestSettings  testOptions    Nothing "./test/testdata/LiftToToplevel/WhereIn1.hs" (12,18)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/WhereIn1.hs" (12,18)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions    Nothing "./test/testdata/LiftToToplevel/WhereIn1.hs" (12,18)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/WhereIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/WhereIn1.hs.expected"@@ -121,8 +121,8 @@     -- ---------------------------------      it "liftToTopLevel WhereIn6 13 29" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/WhereIn6.hs" (13,29)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/WhereIn6.hs" (13,29)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/WhereIn6.hs" (13,29)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/WhereIn6.hs" (13,29)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/WhereIn6.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/WhereIn6.hs.expected"@@ -133,8 +133,8 @@     -- ---------------------------------      it "liftToTopLevel WhereIn7 12 14" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/WhereIn7.hs" (12,14)-     -- r <- liftToTopLevel logTestSettings testOptions "./test/testdata/LiftToToplevel/WhereIn7.hs" (12,14)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/WhereIn7.hs" (12,14)+     -- r <- ct $ liftToTopLevel logTestSettings testOptions "./LiftToToplevel/WhereIn7.hs" (12,14)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/WhereIn7.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/WhereIn7.hs.expected"@@ -144,8 +144,8 @@     -- ---------------------------------      it "liftToTopLevel LetIn1 11 22" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/LetIn1.hs" (11,22)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/LetIn1.hs" (11,22)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/LetIn1.hs" (11,22)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/LetIn1.hs" (11,22)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/LetIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/LetIn1.hs.expected"@@ -156,8 +156,8 @@     -- ---------------------------------      it "liftToTopLevel LetIn2 10 22" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/LetIn2.hs" (10,22)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/LetIn2.hs" (10,22)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/LetIn2.hs" (10,22)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/LetIn2.hs" (10,22)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/LetIn2.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/LetIn2.hs.expected"@@ -168,8 +168,8 @@     -- ---------------------------------      it "liftToTopLevel LetIn3 10 27" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/LetIn3.hs" (10,27)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/LetIn3.hs" (10,27)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/LetIn3.hs" (10,27)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/LetIn3.hs" (10,27)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/LetIn3.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/LetIn3.hs.expected"@@ -178,32 +178,52 @@      -- --------------------------------- +{-+   This is trying to test an invalid lift+     it "liftToTopLevel PatBindIn1 18 7" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/PatBindIn1.hs" (18,7)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/PatBindIn1.hs" (18,7)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/PatBindIn1.hs" (18,7)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/PatBindIn1.hs" (18,7)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/PatBindIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/PatBindIn1.hs.expected"                           "./test/testdata/LiftToToplevel/PatBindIn1.refactored.hs"      diff `shouldBe` []+-}      -- --------------------------------- +    it "liftToTopLevel PatBindIn2 17 7 fails" $ do+     res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/PatBindIn2.hs" (17,7))+     -- ct $ liftToTopLevel logTestSettings testOptions "./LiftToToplevel/PatBindIn2.hs" (17,7)++     (show res) `shouldBe`  "Just \"Cannot lift a declaration assigning to a tuple pattern\""++    -- ---------------------------------+     it "liftToTopLevel PatBindIn3 11 15" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/PatBindIn3.hs" (11,15)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/PatBindIn3.hs" (11,15)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/PatBindIn3.hs" (11,15)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/PatBindIn3.hs" (11,15)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/PatBindIn3.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/PatBindIn3.hs.expected"                           "./test/testdata/LiftToToplevel/PatBindIn3.refactored.hs"      diff `shouldBe` [] +    -- --------------------------------- +    it "liftToTopLevel PatBindIn4 12 30 fails" $ do+     res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/PatBindIn4.hs" (12,30))+     -- ct $ liftToTopLevel logTestSettings testOptions "./LiftToToplevel/PatBindIn4.hs" (12,30)++     (show res) `shouldBe` "Just \"Cannot lift a declaration assigning to a tuple pattern\""++     -- ---------------------------------      it "liftToTopLevel CaseIn1 10 28" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/CaseIn1.hs" (10,28)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/CaseIn1.hs" (10,28)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/CaseIn1.hs" (10,28)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/CaseIn1.hs" (10,28)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/CaseIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/CaseIn1.hs.expected"@@ -213,30 +233,18 @@      -- --------------------------------- -    it "liftToTopLevel PatBindIn2 17 7 fails" $ do-{--     res <- catchException (doLiftToTopLevel ["./test/testdata/LiftToToplevel/PatBindIn2.hs","17","7"])-     -- liftToTopLevel logTestSettings     Nothing "./test/testdata/LiftToToplevel/PatBindIn2.hs" (17,7)--     (show res) `shouldBe` "Just \"\\nThe identifier is not a local function/pattern name!\""--}-     pending -- Not clear that this was covered in the original, will-             -- come back to it--    -- ----------------------------------     it "liftToTopLevel WhereIn2 11 18 fails" $ do      -- res <- catchException (doLiftToTopLevel ["./test/testdata/LiftToToplevel/WhereIn2.hs","11","18"])-     res <- catchException (liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/WhereIn2.hs" (11,18))+     res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/WhereIn2.hs" (11,18))      -- liftToTopLevel logTestSettings  testOptions    Nothing "./test/testdata/LiftToToplevel/WhereIn2.hs" (11,18) -     (show res) `shouldBe` "Just \"The identifier(s): (sq, test/testdata/LiftToToplevel/WhereIn2.hs:11:18) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""+     (show res) `shouldBe` "Just \"The identifier(s): (sq, LiftToToplevel/WhereIn2.hs:11:18) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""      -- ---------------------------------      it "liftToTopLevel Collapse1 8 6" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Collapse1.hs" (8,6)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Collapse1.hs" (8,6)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Collapse1.hs" (8,6)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Collapse1.hs" (8,6)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/Collapse1.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/Collapse1.expected.hs"@@ -266,8 +274,8 @@     -- ---------------------------------      it "liftToTopLevel Zmapq" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Zmapq.hs" (6,3)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Zmapq.hs" (6,3)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Zmapq.hs" (6,3)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Zmapq.hs" (6,3)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/Zmapq.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/Zmapq.expected.hs"@@ -277,8 +285,8 @@     -- ---------------------------------      it "liftToTopLevel LiftInLambda 10 5" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/LiftInLambda.hs" (10,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/LiftInLambda.hs" (10,5)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/LiftInLambda.hs" (10,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/LiftInLambda.hs" (10,5)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/LiftInLambda.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/LiftInLambda.expected.hs"@@ -288,8 +296,8 @@     -- ---------------------------------      it "liftToTopLevel NoWhere" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/NoWhere.hs" (14,12)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/NoWhere.hs" (14,12)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/NoWhere.hs" (14,12)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/NoWhere.hs" (14,12)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/NoWhere.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/NoWhere.expected.hs"@@ -299,8 +307,8 @@     -- ---------------------------------      it "liftToTopLevel Signature" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature.hs" (9,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature.hs" (9,5)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature.hs" (9,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature.hs" (9,5)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/Signature.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/Signature.expected.hs"@@ -312,13 +320,13 @@      it "liftToTopLevel Signature2" $ do     -- should throw exception for forall in signature-     res <- catchException (liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature2.hs" (16,5))-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature2.hs" (16,5)+     res <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature2.hs" (16,5))+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature2.hs" (16,5)      (show res) `shouldBe` "Just \"\\nNew type signature may fail type checking: :: (forall t. Num t => t -> t -> t) -> Int -> \\n\""       {--     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature2.hs" (16,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature2.hs" (16,5)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature2.hs" (16,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature2.hs" (16,5)      (show r) `shouldBe` "[\"./test/testdata/LiftToToplevel/Signature2.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/Signature2.expected.hs"                           "./test/testdata/LiftToToplevel/Signature2.refactored.hs"@@ -330,9 +338,9 @@      it "liftToTopLevel Signature2r" $ do     -- should throw exception for forall in signature-     r <- catchException (liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature2r.hs" (12,5))-     -- r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature2r.hs" (12,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature2r.hs" (12,5)+     r <- catchException (ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature2r.hs" (12,5))+     -- r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature2r.hs" (12,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature2r.hs" (12,5)      (show r) `shouldBe` "Just \"\\nNew type signature may fail type checking: :: (forall t. Num t => t -> t -> t) -> Int -> \\n\""      {-      (show r) `shouldBe` "[\"./test/testdata/LiftToToplevel/Signature2r.hs\"]"@@ -344,8 +352,8 @@     -- ---------------------------------      it "liftToTopLevel Signature3" $ do-     r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature3.hs" (9,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature3.hs" (9,5)+     r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature3.hs" (9,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature3.hs" (9,5)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftToToplevel/Signature3.hs\"]"      diff <- compareFiles "./test/testdata/LiftToToplevel/Signature3.expected.hs"@@ -356,9 +364,9 @@      it "liftToTopLevel Signature4" $ do     -- should throw exception for forall in signature-     r <- catchException $ liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature4.hs" (9,5)-     -- r <- liftToTopLevel defaultTestSettings testOptions "./test/testdata/LiftToToplevel/Signature4.hs" (9,5)-     -- r <- liftToTopLevel logTestSettings  testOptions "./test/testdata/LiftToToplevel/Signature4.hs" (9,5)+     r <- catchException $ ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature4.hs" (9,5)+     -- r <- ct $ liftToTopLevel defaultTestSettings testOptions "./LiftToToplevel/Signature4.hs" (9,5)+     -- r <- ct $ liftToTopLevel logTestSettings  testOptions "./LiftToToplevel/Signature4.hs" (9,5)      (show r) `shouldBe` "Just \"\\nNew type signature may fail type checking: :: (forall t. (Integral t, Num t) => t -> t -> Int) -> t -> \\n\""      {-      (show r) `shouldBe` "[\"./test/testdata/LiftToToplevel/Signature4.hs\"]"@@ -423,8 +431,8 @@     -- ---------------------------------      it "LiftOneLevel WhereIn1 12 18" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn1.hs" (12,18)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/WhereIn1.hs" (12,18)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/WhereIn1.hs" (12,18)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/WhereIn1.hs" (12,18)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/WhereIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/WhereIn1.hs.expected"@@ -434,8 +442,8 @@     -- ---------------------------------      it "LiftOneLevel WhereIn6 13 29" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn6.hs" (13,29)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/WhereIn6.hs" (13,29)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/WhereIn6.hs" (13,29)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/WhereIn6.hs" (13,29)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/WhereIn6.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/WhereIn6.hs.expected"@@ -446,8 +454,8 @@     -- ---------------------------------      it "liftOneLevel WhereIn7 12 14" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn7.hs" (12,14)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/WhereIn7.hs" (12,14)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/WhereIn7.hs" (12,14)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/WhereIn7.hs" (12,14)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/WhereIn7.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/WhereIn7.hs.expected"@@ -457,8 +465,8 @@     -- ---------------------------------      it "LiftOneLevel WhereIn8 8 11" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn8.hs" (8,11)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/WhereIn8.hs" (8,11)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/WhereIn8.hs" (8,11)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/WhereIn8.hs" (8,11)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/WhereIn8.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/WhereIn8.hs.expected"@@ -468,8 +476,8 @@     -- ---------------------------------      it "LiftOneLevel LetIn1 11 22" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/LetIn1.hs" (11,22)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/LetIn1.hs" (11,22)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/LetIn1.hs" (11,22)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/LetIn1.hs" (11,22)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/LetIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/LetIn1.hs.expected"@@ -480,8 +488,8 @@     -- ---------------------------------      it "LiftOneLevel LetIn2 11 22" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/LetIn2.hs" (11,22)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/LetIn2.hs" (11,22)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/LetIn2.hs" (11,22)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/LetIn2.hs" (11,22)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/LetIn2.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/LetIn2.hs.expected"@@ -491,8 +499,8 @@     -- ---------------------------------      it "LiftOneLevel LetIn3 10 27" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/LetIn3.hs" (10,27)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/LetIn3.hs" (10,27)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/LetIn3.hs" (10,27)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/LetIn3.hs" (10,27)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/LetIn3.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/LetIn3.hs.expected"@@ -502,8 +510,8 @@     -- ---------------------------------      it "LiftOneLevel PatBindIn3 11 15" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/PatBindIn3.hs" (11,15)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/PatBindIn3.hs" (11,15)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/PatBindIn3.hs" (11,15)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/PatBindIn3.hs" (11,15)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/PatBindIn3.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/PatBindIn3.hs.expected"@@ -513,8 +521,8 @@     -- ---------------------------------      it "liftOneLevel CaseIn1 10 28" $ do-     r <- liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/CaseIn1.hs" (10,28)-     -- r <- liftOneLevel logTestSettings  testOptions "./test/testdata/LiftOneLevel/CaseIn1.hs" (10,28)+     r <- ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/CaseIn1.hs" (10,28)+     -- r <- ct $ liftOneLevel logTestSettings  testOptions "./LiftOneLevel/CaseIn1.hs" (10,28)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/LiftOneLevel/CaseIn1.hs\"]"      diff <- compareFiles "./test/testdata/LiftOneLevel/CaseIn1.hs.expected"@@ -535,9 +543,9 @@     -- -----------------------------------------------------------------      it "fails WhereIn2 8 18" $ do-     res <- catchException (liftOneLevel defaultTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn2.hs" (8,18))-     -- liftOneLevel logTestSettings testOptions "./test/testdata/LiftOneLevel/WhereIn2.hs" (8,18)-     (show res) `shouldBe` "Just \"The identifier(s): (sq, test/testdata/LiftOneLevel/WhereIn2.hs:8:18) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""+     res <- catchException (ct $ liftOneLevel defaultTestSettings testOptions "./LiftOneLevel/WhereIn2.hs" (8,18))+     -- liftOneLevel logTestSettings testOptions "./LiftOneLevel/WhereIn2.hs" (8,18)+     (show res) `shouldBe` "Just \"The identifier(s): (sq, LiftOneLevel/WhereIn2.hs:8:18) will cause name clash/capture or ambiguity occurrence problem after lifting, please do renaming first!\""   -- TODO: check that other declarations in a list that make use of the@@ -569,19 +577,19 @@      it "notifies if no definition selected" $ do      -- res <- catchException (doDemote ["./test/testdata/MoveDef/Md1.hs","14","13"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (14,13))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./MoveDef/Md1.hs" (14,13))      (show res) `shouldBe` "Just \"\\nInvalid cursor position!\""      it "will not demote if nowhere to go" $ do-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (8,1))-     -- res <- demote logTestSettings testOptions "./test/testdata/MoveDef/Md1.hs" (8,1)+     res <- catchException (ct $ demote defaultTestSettings testOptions "./MoveDef/Md1.hs" (8,1))+     -- res <- ct $ demote logTestSettings testOptions "./MoveDef/Md1.hs" (8,1)      (show res) `shouldBe` "Just \"\\n Nowhere to demote this function!\\n\""      -- -----------------------------------------------------------------      it "demotes a definition from the top level 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/MoveDef/Demote.hs" (7,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/MoveDef/Demote.hs" (7,1)+     r <- ct $ demote defaultTestSettings testOptions "./MoveDef/Demote.hs" (7,1)+     -- r <- ct $ demote logTestSettings testOptions "./MoveDef/Demote.hs" (7,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/MoveDef/Demote.hs\"]"      diff <- compareFiles "./test/testdata/MoveDef/Demote.refactored.hs"@@ -591,8 +599,8 @@     -- -----------------------------------------------------------------      it "demotes a definition from the top level D1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/D1.hs" (9,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/D1.hs" (9,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/D1.hs" (9,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/D1.hs" (9,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/D1.hs\"]"      diff <- compareFiles "./test/testdata/Demote/D1.refactored.hs"@@ -602,7 +610,7 @@     -- -----------------------------------------------------------------      it "demotes WhereIn1 12 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn1.hs" (12,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn1.hs" (12,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn1.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn1.refactored.hs"@@ -612,8 +620,8 @@     -- -----------------------------------------------------------------      it "demotes WhereIn3 14 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn3.hs" (14,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/WhereIn3.hs" (14,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn3.hs" (14,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/WhereIn3.hs" (14,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn3.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn3.refactored.hs"@@ -624,7 +632,7 @@      it "demotes WhereIn4 14 1" $ do      -- r <- doDemote ["./test/testdata/Demote/WhereIn4.hs","14","1"]-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn4.hs" (14,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn4.hs" (14,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn4.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn4.refactored.hs"@@ -634,8 +642,8 @@     -- -----------------------------------------------------------------      it "demotes WhereIn5 14 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn5.hs" (14,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/WhereIn5.hs" (14,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn5.hs" (14,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/WhereIn5.hs" (14,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn5.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn5.refactored.hs"@@ -645,8 +653,8 @@     -- -----------------------------------------------------------------      it "demotes WhereIn6 13 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn6.hs" (13,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/WhereIn6.hs" (13,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn6.hs" (13,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/WhereIn6.hs" (13,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn6.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn6.refactored.hs"@@ -656,8 +664,8 @@     -- -----------------------------------------------------------------      it "demotes WhereIn7 13 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn7.hs" (13,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/WhereIn7.hs" (13,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/WhereIn7.hs" (13,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/WhereIn7.hs" (13,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/WhereIn7.hs\"]"      diff <- compareFiles "./test/testdata/Demote/WhereIn7.refactored.hs"@@ -667,8 +675,8 @@     -- -----------------------------------------------------------------      it "demotes CaseIn1 16 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/CaseIn1.hs" (16,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/CaseIn1.hs" (16,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/CaseIn1.hs" (16,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/CaseIn1.hs" (16,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/CaseIn1.hs\"]"      diff <- compareFiles "./test/testdata/Demote/CaseIn1.refactored.hs"@@ -678,8 +686,8 @@     -- -----------------------------------------------------------------      it "demotes LetIn1 12 22" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/LetIn1.hs" (12,22)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/LetIn1.hs" (12,22)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/LetIn1.hs" (12,22)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/LetIn1.hs" (12,22)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/LetIn1.hs\"]"      diff <- compareFiles "./test/testdata/Demote/LetIn1.refactored.hs"@@ -689,7 +697,7 @@     -- -----------------------------------------------------------------      it "demotes PatBindIn1 19 1" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/PatBindIn1.hs" (19,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/PatBindIn1.hs" (19,1)      r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/PatBindIn1.hs\"]"      diff <- compareFiles "./test/testdata/Demote/PatBindIn1.refactored.hs"@@ -698,20 +706,20 @@      -- ----------------------------------------------------------------- -    it "demotes D2 5 1 when not imported by other module" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/D2.hs" (5,1)-     -- r <- demote logTestSettings testOptions "./test/testdata/Demote/D2.hs" (5,1)+    it "demotes D2a 5 1 when not imported by other module" $ do+     r <- ct $ demote defaultTestSettings testOptions "./Demote/D2a.hs" (5,1)+     -- r <- ct $ demote logTestSettings testOptions "./Demote/D2a.hs" (5,1)      r' <- mapM makeRelativeToCurrentDirectory r-     (show r') `shouldBe` "[\"test/testdata/Demote/D2.hs\"]"-     diff <- compareFiles "./test/testdata/Demote/D2.refactored.hs"-                          "./test/testdata/Demote/D2.hs.expected"+     (show r') `shouldBe` "[\"test/testdata/Demote/D2a.hs\"]"+     diff <- compareFiles "./test/testdata/Demote/D2a.refactored.hs"+                          "./test/testdata/Demote/D2a.hs.expected"      diff `shouldBe` []      -- -----------------------------------------------------------------      it "fails WhereIn2 14 1" $ do      -- res <- catchException (doDemote ["./test/testdata/Demote/WhereIn2.hs","14","1"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn2.hs" (14,1))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/WhereIn2.hs" (14,1))      -- demote (Just logSettings) testOptions Nothing "./test/testdata/Demote/WhereIn2.hs" (14,1)      (show res) `shouldBe` "Just \"\\n Nowhere to demote this function!\\n\"" @@ -719,14 +727,14 @@      it "fails LetIn2 11 22" $ do      -- res <- catchException (doDemote ["./test/testdata/Demote/LetIn2.hs","11","22"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/LetIn2.hs" (11,22))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/LetIn2.hs" (11,22))      (show res) `shouldBe` "Just \"This function can not be demoted as it is used in current level!\\n\""      -- -----------------------------------------------------------------      it "fails PatBindIn4 18 1" $ do      -- res <- catchException (doDemote ["./test/testdata/Demote/PatBindIn4.hs","18","1"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/PatBindIn4.hs" (18,1))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/PatBindIn4.hs" (18,1))      -- (show res) `shouldBe` "Just \"\\n Nowhere to demote this function!\\n\""      (show res) `shouldBe` "Just \"\\nThis function/pattern binding is used by more than one friend bindings\\n\"" @@ -734,7 +742,7 @@      it "fails WhereIn8 16 1" $ do      -- res <- catchException (doDemote ["./test/testdata/Demote/WhereIn8.hs","16","1"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/WhereIn8.hs" (16,1))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/WhereIn8.hs" (16,1))      (show res) `shouldBe` "Just \"\\n Nowhere to demote this function!\\n\""      -- -----------------------------------------------------------------@@ -753,7 +761,7 @@      it "fails D3 5 1" $ do      -- res <- catchException (doDemote ["./test/testdata/Demote/D3.hs","5","1"])-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/D3.hs" (5,1))+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/D3.hs" (5,1))      (show res) `shouldBe` "Just \"This definition can not be demoted, as it is explicitly exported by the current module!\""  @@ -783,16 +791,16 @@     -- -----------------------------------------------------------------      it "fails MultiLeg.hs" $ do-     res <- catchException (demote defaultTestSettings testOptions "./test/testdata/Demote/MultiLeg.hs" (14,1))-     -- demote logTestSettings testOptions "./test/testdata/Demote/MultiLeg.hs" (14,1)+     res <- catchException (ct $ demote defaultTestSettings testOptions "./Demote/MultiLeg.hs" (14,1))+     -- demote logTestSettings testOptions "./Demote/MultiLeg.hs" (14,1)      (show res) `shouldBe` "Just \"\\nThis function/pattern binding is used by more than one friend bindings\\n\""       -- -----------------------------------------------------------------      it "passes MultiLeg2.hs" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/MultiLeg2.hs" (14,1)-     -- demote logTestSettings testOptions "./test/testdata/Demote/MultiLeg2.hs" (14,1)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/MultiLeg2.hs" (14,1)+     -- demote logTestSettings testOptions "./Demote/MultiLeg2.hs" (14,1)       r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/MultiLeg2.hs\"]"@@ -804,8 +812,8 @@     -- -----------------------------------------------------------------      it "passes UsedAtLevel.hs" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/UsedAtLevel.hs" (19,12)-     -- demote logTestSettings testOptions "./test/testdata/Demote/UsedAtLevel.hs" (19,12)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/UsedAtLevel.hs" (19,12)+     -- demote logTestSettings testOptions "./Demote/UsedAtLevel.hs" (19,12)       r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/UsedAtLevel.hs\"]"@@ -816,8 +824,8 @@     -- -----------------------------------------------------------------      it "passes UsedAtLevel.hs2" $ do-     r <- demote defaultTestSettings testOptions "./test/testdata/Demote/UsedAtLevel2.hs" (23,12)-     -- demote logTestSettings testOptions "./test/testdata/Demote/UsedAtLevel2.hs" (23,12)+     r <- ct $ demote defaultTestSettings testOptions "./Demote/UsedAtLevel2.hs" (23,12)+     -- demote logTestSettings testOptions "./Demote/UsedAtLevel2.hs" (23,12)       r' <- mapM makeRelativeToCurrentDirectory r      (show r') `shouldBe` "[\"test/testdata/Demote/UsedAtLevel2.hs\"]"

@@ -207,7 +207,7 @@      it "renames in Field4 5 23" $ do      r <- ct $ rename defaultTestSettings testOptions "./Renaming/Field4.hs" "value2" (5,23)-     -- ct $ rename logTestSettings Nothing "./Renaming/Field4.hs" "value2" (5,23)+     -- ct $ rename logTestSettings testOptions "./Renaming/Field4.hs" "value2" (5,23)      r' <- ct $ mapM makeRelativeToCurrentDirectory r      r' `shouldBe` [ "Renaming/Field4.hs"                   ]@@ -301,6 +301,18 @@      -- --------------------------------- +    it "renames in Constructor 5 16" $ do+     r <- ct $ rename defaultTestSettings testOptions "./Renaming/Constructor.hs" "MyType" (5,16)+     -- ct $ rename logTestSettings testOptions "./Renaming/Constructor.hs" "MyType" (5,16)+     r' <- ct $ mapM makeRelativeToCurrentDirectory r+     r' `shouldBe` [ "Renaming/Constructor.hs"+                  ]+     diff <- ct $ compareFiles "./Renaming/Constructor.expected.hs"+                               "./Renaming/Constructor.refactored.hs"+     diff `shouldBe` []++    -- ---------------------------------+     it "renames in LayoutIn1 7 17" $ do      r <- ct $ rename defaultTestSettings testOptions "./Renaming/LayoutIn1.hs" "square" (7,17)      -- ct $ rename logTestSettings testOptions "./Renaming/LayoutIn1.hs" "square" (7,17)@@ -315,7 +327,7 @@      it "renames in LayoutIn2 8 7" $ do      r <- ct $ rename defaultTestSettings testOptions "./Renaming/LayoutIn2.hs" "ls" (8,7)-     -- ct $ rename logTestSettings testOptions Nothing "./Renaming/LayoutIn2.hs" "ls" (8,7)+     -- ct $ rename logTestSettings testOptions "./Renaming/LayoutIn2.hs" "ls" (8,7)      r' <- ct $ mapM makeRelativeToCurrentDirectory r      r' `shouldBe` [ "Renaming/LayoutIn2.hs"                   ]@@ -366,8 +378,8 @@     -- ---------------------------------      it "naming clash IdIn5" $ do-     -- ct $ rename logTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1)-     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/IdIn5.hs" "y" (10,1))+     -- ct $ rename logTestSettings testOptions "./Renaming/IdIn5.hs" "y" (13,1)+     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/IdIn5.hs" "y" (13,1))      (show res) `shouldBe` "Just \"Name 'y' already exists, or renaming 'IdIn5.x' to 'y' will change the program's semantics!\\n\""      -- ---------------------------------@@ -394,7 +406,7 @@     -- ---------------------------------      it "cannot rename main Main" $ do-     -- rename logTestSettings testOptions Nothing "./Renaming/Main.hs" "main1" (11,1)+     -- rename logTestSettings testOptions "./Renaming/Main.hs" "main1" (11,1)      res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/Main.hs" "main1" (11,1))      (show res) `shouldBe` "Just \"The 'main' function defined in a 'Main' module should not be renamed!\"" @@ -407,8 +419,36 @@      -- --------------------------------- +    it "cannot rename x InScopes 1" $ do+     -- res <- catchException (ct $ rename logTestSettings testOptions "./Renaming/InScopes.hs" "g" (6,22))+     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/InScopes.hs" "g" (6,22))+     show res `shouldBe` "Just \"The new name will cause name capture!\""++    -- ---------------------------------++    it "cannot rename x InScopes 2" $ do+     -- res <- catchException (ct $ rename logTestSettings testOptions "./Renaming/InScopes.hs" "g" (10,10))+     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/InScopes.hs" "g" (10,10))+     show res `shouldBe` "Just \"The new name will cause name capture!\""++    -- ---------------------------------++    it "cannot rename x InScopes 3" $ do+     -- res <- catchException (ct $ rename logTestSettings testOptions "./Renaming/InScopes.hs" "g" (12,8))+     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/InScopes.hs" "g" (12,8))+     show res `shouldBe` "Just \"The new name will cause name capture!\""++    -- ---------------------------------++    it "cannot rename x InScopes 4" $ do+     -- res <- catchException (ct $ rename logTestSettings testOptions "./Renaming/InScopes.hs" "g" (21,12))+     res <- catchException (ct $ rename defaultTestSettings testOptions "./Renaming/InScopes.hs" "g" (21,12))+     show res `shouldBe` "Just \"The new name will cause name capture!\""++    -- ---------------------------------+     it "rename with default main Main2" $ do-     -- ct $ rename logTestSettings testOptions Nothing "./Renaming/Main2.hs" "baz" (6,1)+     -- ct $ rename logTestSettings testOptions "./Renaming/Main2.hs" "baz" (6,1)      r <- ct $ rename defaultTestSettings testOptions "./Renaming/Main2.hs" "baz" (6,1)       r' <- ct $ mapM makeRelativeToCurrentDirectory r@@ -584,6 +624,48 @@      (show r') `shouldBe` "[\"Renaming/RenameInExportedType2.hs\"]"      diff <- ct $ compareFiles "./Renaming/RenameInExportedType2.refactored.hs"                                "./Renaming/RenameInExportedType2.expected.hs"+     diff `shouldBe` []++    -- -----------------------------------------------------------------++    it "passes ExportedType.hs for type name" $ do+     r <- ct $ rename defaultTestSettings testOptions "./Renaming/ExportedType.hs" "NewType" (4,7)+     -- ct $ rename logTestSettings testOptions "./Renaming/ExportedType.hs" "NewType" (4,7)++     r' <- ct $ mapM makeRelativeToCurrentDirectory r+     (show r') `shouldBe` "[\"Renaming/ExportedType.hs\",\"Renaming/ExportedTypeClient.hs\"]"+     diff <- ct $ compareFiles "./Renaming/ExportedType.refactored.hs"+                               "./Renaming/ExportedType.expected.hs"+     diff `shouldBe` []+     diff2 <- ct $ compareFiles "./Renaming/ExportedTypeClient.refactored.hs"+                                "./Renaming/ExportedTypeClient.expected.hs"+     diff2 `shouldBe` []++    -- -----------------------------------------------------------------++    it "passes ExportedType.hs for type constructor" $ do+     r <- ct $ rename defaultTestSettings testOptions "./Renaming/ExportedType.hs" "NewType" (4,16)+     -- ct $ rename logTestSettings testOptions "./Renaming/ExportedType.hs" "NewType" (4,16)++     r' <- ct $ mapM makeRelativeToCurrentDirectory r+     (show r') `shouldBe` "[\"Renaming/ExportedType.hs\",\"Renaming/ExportedTypeClient.hs\"]"+     diff <- ct $ compareFiles "./Renaming/ExportedType.refactored.hs"+                               "./Renaming/ExportedType.expected2.hs"+     diff `shouldBe` []+     diff2 <- ct $ compareFiles "./Renaming/ExportedTypeClient.refactored.hs"+                                "./Renaming/ExportedTypeClient.expected2.hs"+     diff2 `shouldBe` []++    -- -----------------------------------------------------------------++    it "passes WildCard.hs" $ do+     r <- ct $ rename defaultTestSettings testOptions "./Renaming/WildCard.hs" "taggedPlugins2" (7,1)+     -- r <- ct $ rename logTestSettings testOptions "./Renaming/WildCard.hs" "taggedPlugins2" (7,1)++     r' <- ct $ mapM makeRelativeToCurrentDirectory r+     (show r') `shouldBe` "[\"Renaming/WildCard.hs\"]"+     diff <- ct $ compareFiles "./Renaming/WildCard.refactored.hs"+                               "./Renaming/WildCard.expected.hs"      diff `shouldBe` []      -- -----------------------------------------------------------------

@@ -1,7 +0,0 @@-{-# OPTIONS_GHC -F -pgmF hspec-discover #-}-{---See https://github.com/hspec/hspec/tree/master/hspec-discover#readme-to understand this module---}

@@ -25,7 +25,7 @@    describe "swapArgs" $ do     it "checks for that an identifier is selected" $ do-     res <- catchException (swapArgs defaultTestSettings testOptions ["./test/testdata/SwapArgs/B.hs","4","1"])+     res <- catchException (ct $ swapArgs defaultTestSettings testOptions ["./SwapArgs/B.hs","4","1"])      -- let res = "foo"      (show res) `shouldBe` "Just \"Incorrect identifier selected!\"" 

@@ -255,7 +255,7 @@     Just tm -> r       where         anns = tkCache (rsTokenCache tm) Map.! mainTid-        parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module+        parsed = GHC.pm_parsed_source $ tmParsedModule                  $ rsTypecheckedMod tm         r = showAnnData anns 0 parsed     Nothing -> []@@ -304,7 +304,7 @@     Just tm -> r       where         anns = tkCache (rsTokenCache tm) Map.! mainTid-        parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module+        parsed = GHC.pm_parsed_source $ tmParsedModule                  $ rsTypecheckedMod tm         r = exactPrint parsed anns     Nothing -> []

@@ -18,12 +18,14 @@ import Language.Haskell.GHC.ExactPrint import Language.Haskell.GHC.ExactPrint.Parsers import Language.Haskell.GHC.ExactPrint.Types+import Language.Haskell.GHC.ExactPrint.Utils  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.Types import Language.Haskell.Refact.Utils.Utils import Language.Haskell.Refact.Utils.Variables @@ -41,8 +43,8 @@   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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (4,5) parsed@@ -58,7 +60,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just (res'@(GHC.L l _)) = locToRdrName (7,3) parsed@@ -72,7 +74,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just (res'@(GHC.L l _)) = locToRdrName (25,8) parsed@@ -86,7 +88,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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let res = locToNameRdrPure nm (7,7) parsed@@ -96,7 +98,7 @@      it "gets a short name too" $ do       t <- ct $ parsedFileGhc "./Demote/WhereIn2.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just (res'@(GHC.L l _)) = locToRdrName (14,1) parsed@@ -110,7 +112,7 @@      it "gets a type variable name" $ do       t <- ct $ parsedFileGhc "./Renaming/ConstructorIn3.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just (res'@(GHC.L l _)) = locToRdrName (9,12) parsed@@ -125,7 +127,7 @@      it "gets an instance class name" $ do       t <- ct $ parsedFileGhc "./Renaming/ClassIn3.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just (res'@(GHC.L l _)) = locToRdrName (16,10) parsed           n = rdrName2NamePure nm res'@@ -139,7 +141,7 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t        let Just (res@(GHC.L l n)) = locToRdrName (20,1) parsed       (show $ ss2span l) `shouldBe` "((20,1),(20,11))"@@ -148,7 +150,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t        let Just (res@(GHC.L l n)) = locToRdrName (24,2) parsed       showGhcQual n `shouldBe` "sumSquares"@@ -160,21 +162,21 @@   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 renamed = tmRenamedSource 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 renamed = tmRenamedSource 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 renamed = tmRenamedSource t       let res = getName "baz" renamed       (showGhcQual res) `shouldBe` "Nothing" @@ -183,7 +185,7 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (16,6) parsed       let decls = GHC.hsmodDecls $ GHC.unLoc parsed@@ -194,7 +196,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (3,3) parsed@@ -206,7 +208,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (13,29) parsed@@ -219,7 +221,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (11,22) parsed@@ -232,7 +234,7 @@      it "finds in a patbind" $ do       t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (14,1) parsed@@ -260,13 +262,35 @@       -}       pending -- "Convert to definingDeclsNames" +    -- ---------------------------------++    it "finds a name declared in a RecCon data declaration" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          nm <- getRefactNameMap+          let Just n = locToNameRdrPure nm (5,18) parsed+          let rg = definingDeclsRdrNames nm [n] decls False False+          return (n,rg)+      -- ((bb,resg),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((nn,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual nn) `shouldBe` "Field1.pointx"++      (showGhcQual resg) `shouldBe` "[data Point\n   = Pt {pointx, pointy :: Float}\n   deriving (Show)]"++  -- ---------------------------------------   -- ------------------------------------------------------------------- {-   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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (16,6) parsed@@ -275,8 +299,8 @@      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 renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (3,3) parsed@@ -286,8 +310,8 @@      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 renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (14,1) parsed@@ -316,7 +340,7 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (21,1) parsed@@ -328,7 +352,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (4,1) parsed@@ -340,7 +364,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7,1) parsed@@ -352,7 +376,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (16,5) parsed@@ -364,7 +388,7 @@      it "finds multiple signatures 1" $ do       t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n1 = locToNameRdrPure nm (21,1) parsed@@ -383,7 +407,7 @@      it "finds multiple signatures 2" $ do       t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n1 = locToNameRdrPure nm (14,1) parsed@@ -403,7 +427,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (10,29) parsed@@ -419,7 +443,7 @@      it "finds family declarations" $ do       t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       -- putStrLn $ "parsed:" ++ SYB.showData SYB.Parser 0 parsed @@ -431,7 +455,7 @@      it "finds data declarations" $ do       t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (12,6) parsed@@ -440,9 +464,20 @@      -- --------------------------------- +    it "finds field names in data declarations" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field4.hs"+      let parsed = GHC.pm_parsed_source $ tmParsedModule t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (5,23) parsed+      let res = definingTyClDeclsNames nm [n] parsed+      (unspace $ showGhcQual res) `shouldBe` "[data Vtree a\n = Vleaf {value1 :: a} |\n Vnode {value2 :: a, left, right :: Vtree a}]"++    -- ---------------------------------+     it "finds type declarations" $ do       t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (14,6) parsed@@ -453,7 +488,7 @@      it "finds class declarations" $ do       t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (16,7) parsed@@ -464,7 +499,7 @@      it "finds multiple declarations" $ do       t <- ct $ parsedFileGhc "./TypeUtils/TyClDecls.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n1 = locToNameRdrPure nm (14,6) parsed@@ -478,8 +513,8 @@   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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let decls = getHsDecls parsed@@ -489,9 +524,9 @@      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+      let (GHC.L _l (GHC.HsModule _name _exps _imps _ds _ _)) = GHC.pm_parsed_source $ tmParsedModule t+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just toplevel = getName "DupDef.Dd1.toplevel" renamed@@ -503,8 +538,8 @@   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+      let renamed  = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        -- putStrLn $ "parsed:\n" ++ SYB.showData SYB.Parser 0 parsed@@ -517,8 +552,8 @@     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+      let renamed  = tmRenamedSource t+      let parsed2 = GHC.pm_parsed_source $ tmParsedModule t2           nm2 = initRdrNameMap t2        let Just tup = getName "DupDef.Dd1.tup" renamed@@ -556,7 +591,7 @@      -- --------------------------------- -    it "finds declared HsVar" $ do+    it "finds free and declared variables" $ do       t <- ct $ parsedFileGhc "./FreeAndDeclared/Declare.hs"       let         comp = do@@ -564,10 +599,9 @@           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+          return rr+      -- ((FN fr,DN dr),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((FN fr,DN dr),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions        -- ---------------------       -- Free Vars - parsed@@ -578,7 +612,8 @@                    "(GHC.Base.$, (-1, -1)),\n "++                    "(GHC.List.head, (-1, -1)), "++                    "(GHC.List.zip, (-1, -1)),\n "++-                   "(System.IO.getChar, (-1, -1)), "+++                   "(GHC.Base.String, (-1, -1)), "+++                   "(System.IO.getChar, (-1, -1)),\n "++                    "(System.IO.putStrLn, (-1, -1)),\n "++                    "(Data.Generics.Text.gshow, (-1, -1))]" @@ -603,42 +638,6 @@                    "(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@@ -649,7 +648,6 @@         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)@@ -659,7 +657,6 @@       (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))]"@@ -677,7 +674,6 @@         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)@@ -686,7 +682,6 @@       (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))]"@@ -704,7 +699,6 @@         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)@@ -714,7 +708,6 @@       (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))]"@@ -723,6 +716,100 @@       (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`                    "[(FreeAndDeclared.DeclareRec.unR2, (7, 1))]" +    -- ---------------------------------++    it "finds free and declared in a RecCon data declaration" $ do+      t <- ct $ parsedFileGhc "./Renaming/Field1.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          let b = head $ drop 0 decls+          rg <- hsFreeAndDeclaredPNs b+          return (b,rg)+      -- ((bb,resg),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual bb) `shouldBe` "data Point\n  = Pt {pointx, pointy :: Float}\n  deriving (Show)"++      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(GHC.Types.Float, (-1, -1)), "+++                   "(GHC.Show.Show, (-1, -1))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(Field1.Point, (5, 1)), "+++                   "(Field1.Pt, (5, 14)),\n "+++                   "(Field1.pointx, (5, 18)), "+++                   "(Field1.pointy, (5, 26))]"++    -- ---------------------------------++    it "finds free and declared in a data declaration, ignoring tyvars 1" $ do+      t <- ct $ parsedFileGhc "./Renaming/D1.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          let b = head $ drop 0 decls+          rg <- hsFreeAndDeclaredPNs b+          return (b,rg)+      -- ((bb,resg),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual bb) `shouldBe` "data Tree a = Leaf a | Branch (Tree a) (Tree a)"++      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(Renaming.D1.Tree, (6, 1)), "+++                   "(Renaming.D1.Leaf, (6, 15)),\n "+++                   "(Renaming.D1.Branch, (6, 24))]"+++    -- ---------------------------------++    it "finds free and declared in a data declaration, ignoring tyvars 2" $ do+      t <- ct $ parsedFileGhc "./Renaming/D1.hs"++      let+        comp = do+          parsed <- getRefactParsed+          decls <- liftT $ hsDecls parsed+          let b = head $ drop 3 decls+          rg <- hsFreeAndDeclaredPNs b+          return (b,rg)+      -- ((bb,resg),_s) <- runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t }) testOptions+      ((bb,resg),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions+++      (showGhcQual bb) `shouldBe` "class SameOrNot c where\n  isSame :: c -> c -> Bool\n  isNotSame :: c -> c -> Bool"++      -- (SYB.showData SYB.Renamer 0 bb) `shouldBe` ""++      -- Free Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (fst resg)) `shouldBe`+                   "[(GHC.Types.Bool, (-1, -1))]"++      -- Declared Vars+      (showGhcQual $ map (\n -> (n, getGhcLoc $ GHC.nameSrcSpan n)) (snd resg)) `shouldBe`+                   "[(Renaming.D1.SameOrNot, (12, 1)), "+++                   "(Renaming.D1.isSame, (13, 4)),\n "+++                   "(Renaming.D1.isNotSame, (14, 4))]"++     -- -----------------------------------------------------------------      it "hsFreeAndDeclaredPNs simplest" $ do@@ -744,7 +831,7 @@      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 renamed = tmRenamedSource t        let Just tup = getName "DupDef.Dd1.ff" renamed @@ -777,7 +864,6 @@       let         comp = do           parsed <- getRefactParsed-          -- r <- hsFreeAndDeclaredPNs $ hsBinds renamed           r <- hsFreeAndDeclaredPNs parsed           return r       ((res),_s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions@@ -818,7 +904,7 @@      it "finds free and declared in a GRHSs" $ do       t <- ct $ parsedFileGhc "./LiftOneLevel/LetIn2.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t+      let renamed = tmRenamedSource t        let Just tup = getName "LiftOneLevel.LetIn2.sumSquares" renamed       let@@ -882,8 +968,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just tl1  = locToExp (4,13) (4,40) parsed :: (Maybe (GHC.Located (GHC.HsExpr GHC.RdrName)))@@ -902,8 +988,8 @@       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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just tl1  = locToExp (28,4) (28,12) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))@@ -929,7 +1015,7 @@       pendingWith "no longer relevant?"  {-       t <- ct $ parsedFileGhc "./DupDef/Dd1.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just tl1  = locToExp (28,4) (28,12) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))@@ -952,8 +1038,8 @@       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 renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t        let Just e  = locToExp (5,11) (5,19) parsed :: (Maybe (GHC.LHsExpr GHC.RdrName))       (showGhcQual e) `shouldBe` "a + b"@@ -978,8 +1064,8 @@       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 renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` ""        let Just e   = locToExp (9,15) (9,17) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))@@ -1003,21 +1089,20 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t -      let Just rhs  = locToExp (14,6) (15,14) parsed  :: (Maybe (GHC.LHsExpr GHC.RdrName))+      let Just rhs  = locToExp (17,6) (18,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+      let Just e  = locToRdrName (17,7) parsed       (showGhcQual e) `shouldBe` "x"-      (SYB.showData SYB.Parser 0 e) `shouldBe` "\n(L {Renaming/IdIn5.hs:14:7} \n (Unqual {OccName: x}))"+      (SYB.showData SYB.Parser 0 e) `shouldBe` "\n(L {Renaming/IdIn5.hs:17: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@@ -1030,7 +1115,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t        let Just ln = locToRdrName (6, 6) parsed       (showGhcQual ln) `shouldBe` "Tree"@@ -1041,18 +1126,17 @@           -- 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.++, "+++      (show _fds) `shouldBe` "(FN [GHC.Base.++, "+++                                  "GHC.Types.Bool, "++                                   "GHC.Types.Int, "++-                                  "GHC.Classes.==, "+++                                  "GHC.Classes.==,\n "++                                   "GHC.Classes./=, "++-                                  ":,\n "+++                                  ":, "++                                   "GHC.Num.+, "++                                   "GHC.Real.^, "++                                   "[]],"++@@ -1071,11 +1155,11 @@      it "finds visible vars inIdIn5" $ do       t <- ct $ parsedFileGhc "./Renaming/IdIn5.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t -      let Just ln = locToRdrName (10, 1) parsed+      let Just ln = locToRdrName (13, 1) parsed       (showGhcQual ln) `shouldBe` "x"-      (SYB.showData SYB.Parser 0 ln) `shouldBe` "\n(L {Renaming/IdIn5.hs:10:1} \n (Unqual {OccName: x}))"+      (SYB.showData SYB.Parser 0 ln) `shouldBe` "\n(L {Renaming/IdIn5.hs:13:1} \n (Unqual {OccName: x}))"        let         comp = do@@ -1087,7 +1171,7 @@       ((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.+],"+++      (show _fds) `shouldBe` "(FN [GHC.Base.String, 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]"@@ -1098,8 +1182,8 @@   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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just e  = locToExp (5,11) (5,19) parsed :: (Maybe (GHC.Located (GHC.HsExpr GHC.RdrName)))@@ -1122,8 +1206,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just e  = locToExp (9,15) (9,17) parsed :: Maybe (GHC.LHsExpr GHC.RdrName)@@ -1144,7 +1228,6 @@           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@@ -1156,8 +1239,8 @@      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 renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t        let Just n = getName "FreeAndDeclared.Declare.tup" renamed @@ -1179,7 +1262,7 @@      it "finds free vars in HsWithBndrs" $ do       t <- ct $ parsedFileGhc "./FreeAndDeclared/Binders.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t+      let renamed = tmRenamedSource t        let Just n = getName "FreeAndDeclared.Binders.findNewPName" renamed       let@@ -1197,7 +1280,6 @@           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@@ -1240,7 +1322,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (17, 5) parsed       (showGhcQual n) `shouldBe` "ff"@@ -1248,7 +1330,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (21, 1) parsed       (showGhcQual n) `shouldBe` "DupDef.Dd1.ff"@@ -1289,7 +1371,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just pn = locToNameRdrPure nm (3, 1) parsed@@ -1305,7 +1387,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just pn = locToNameRdrPure nm (14, 1) parsed@@ -1445,7 +1527,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (3, 1) parsed@@ -1467,7 +1549,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just np = locToNameRdrPure nm (14, 1) parsed@@ -1488,7 +1570,7 @@           (parent',Just (funBinding,declsToDup,declsp')) <- modifyValD (GHC.getLoc parent) parent $ \_m declsp -> do            let-             declsToDup = definingDeclsRdrNames nm [n] declsp True True+             declsToDup = definingDeclsRdrNames nm [n] declsp False True              funBinding = filter isFunOrPatBindP declsToDup     --get the fun binding.             declsp' <- duplicateDecl declsp n newName2@@ -1517,7 +1599,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (3, 1) parsed@@ -1540,7 +1622,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (3, 1) parsed@@ -1562,7 +1644,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 1) parsed@@ -1586,7 +1668,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 21) parsed@@ -1611,7 +1693,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (10, 17) parsed@@ -1633,13 +1715,37 @@       (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" +    -- --------------------------------- +    it "adds parameters to a declaration in a tuple" $ do+      t <- ct $ parsedFileGhc "./AddParams2.hs"+      let parsed = GHC.pm_parsed_source $ tmParsedModule t+          nm = initRdrNameMap t++      let Just n = locToNameRdrPure nm (5, 36) parsed+      let Just e  = locToExp (5,23) (5,47) parsed :: Maybe (GHC.Located (GHC.HsExpr GHC.RdrName))+      let+        comp = do+         let newName1 = mkRdrName "baz"+         let newName2 = mkRdrName "bar"+         e' <- addActualParamsToRhs n [newName1,newName2] e++         return e'+      (nb,s) <- runRefactGhc comp (initialState { rsModule = initRefactModule [] t }) testOptions++      (showGhcQual n) `shouldBe` "rightOuter"+      (showGhcQual e) `shouldBe` "(rightInner, rightOuter)"++      (exactPrintFromState s nb) `shouldBe` " (rightInner, (rightOuter baz bar))"+      -- putStrLn (showAnnDataItemFromState s e)+      -- putStrLn (showAnnDataItemFromState s nb)+   -- ---------------------------------------------    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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (6, 1) parsed       let@@ -1658,7 +1764,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (6, 1) parsed       let@@ -1676,7 +1782,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (22, 1) parsed       let@@ -1695,7 +1801,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (22, 1) parsed@@ -1714,7 +1820,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (11, 22) parsed@@ -1737,7 +1843,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 5) parsed@@ -1758,7 +1864,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` "" @@ -1780,7 +1886,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       -- (SYB.showData SYB.Renamer 0 renamed) `shouldBe` "" @@ -1795,13 +1901,13 @@       -- (_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  "+      (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"      -- -----------------------------------      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (10, 22) parsed@@ -1821,7 +1927,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (14, 1) parsed       let@@ -1840,7 +1946,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (8, 6) parsed       let@@ -1860,7 +1966,7 @@   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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (22, 1) parsed       let@@ -1879,7 +1985,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (14, 1) parsed       let@@ -1899,7 +2005,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (16, 5) parsed       let@@ -1918,7 +2024,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just b = locToNameRdrPure nm (12, 1) parsed       let@@ -1935,7 +2041,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (4, 1) parsed       let@@ -1955,7 +2061,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (12, 1) parsed       let@@ -1967,14 +2073,14 @@       ((_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 "+      (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 renamed = tmRenamedSource t       let Just (GHC.L _ n) = locToName (GHC.mkFastString "./test/testdata/LiftToToplevel/PatBindIn1.hs") (18, 7) renamed       let         comp = do@@ -2100,7 +2206,7 @@          let Just tl = locToNameRdrPure nm (4, 1) parsed          decls <- liftT (hsDecls parsed)          let-             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False+             [tlDecl] = definingDeclsRdrNames nm [tl] decls False False           (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2") @@ -2127,7 +2233,7 @@          let Just tl = locToNameRdrPure nm (4, 1) parsed          decls <- liftT (hsDecls parsed)          let-             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False+             [tlDecl] = definingDeclsRdrNames nm [tl] decls False False           (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")          (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")@@ -2154,7 +2260,7 @@          let Just tl = locToNameRdrPure nm (4, 1) parsed          decls <- liftT (hsDecls parsed)          let-             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False+             [tlDecl] = definingDeclsRdrNames nm [tl] decls False False           (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2") @@ -2179,7 +2285,7 @@          let Just tl = locToNameRdrPure nm (4, 1) parsed          decls <- liftT (hsDecls parsed)          let-             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False+             [tlDecl] = definingDeclsRdrNames nm [tl] decls False False           (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2") @@ -2205,7 +2311,7 @@          let Just tl = locToNameRdrPure nm (4, 1) parsed          decls <- liftT (hsDecls parsed)          let-             [tlDecl] = definingDeclsRdrNames nm [tl] decls True False+             [tlDecl] = definingDeclsRdrNames nm [tl] decls False False           (decl,declAnns) <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "decl" "nn = nn2")          (sig, sigAnns)  <- GHC.liftIO $ withDynFlags (\df -> parseDeclToAnnotated df "sig"  "nn :: Int")@@ -2354,7 +2460,7 @@     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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (19, 1) parsed       (showGhcQual n) `shouldBe` "TokenTest.foo"@@ -2382,7 +2488,7 @@     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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t       let Just n = locToNameRdrPure nm (19, 1) parsed       (showGhcQual n) `shouldBe` "TokenTest.foo"@@ -2411,7 +2517,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (5, 19) parsed@@ -2432,15 +2538,14 @@       -- ((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)"-+      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata Point = Pt {pointx1, pointy :: Float} deriving Show\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\n = Pt {pointx1, pointy :: Float}\n deriving (Show)\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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (5, 6) parsed@@ -2459,14 +2564,15 @@       ((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)"+      (sourceFromState s) `shouldBe` "module Field1 where\n\n--Rename field name 'pointx' to 'pointx1'\n\ndata NewPoint = Pt {pointx, pointy :: Float} deriving Show\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\n = Pt {pointx, pointy :: Float}\n deriving (Show)\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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (20, 1) parsed@@ -2489,7 +2595,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t #if __GLASGOW_HASKELL__ <= 710       let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")@@ -2521,7 +2627,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (8, 7) parsed@@ -2547,7 +2653,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t #if __GLASGOW_HASKELL__ <= 710       let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")@@ -2578,7 +2684,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t #if __GLASGOW_HASKELL__ <= 710       let modu = GHC.mkModule (GHC.stringToPackageKey "mypackage-1.0") (GHC.mkModuleName "LocToName")@@ -2608,8 +2714,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (8, 7) parsed@@ -2636,8 +2742,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (8, 7) parsed@@ -2663,8 +2769,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 8) parsed@@ -2690,8 +2796,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 8) parsed@@ -2716,8 +2822,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 17) parsed@@ -2743,8 +2849,8 @@      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+      -- let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 17) parsed@@ -2771,8 +2877,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 6) parsed@@ -2797,8 +2903,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 6) parsed@@ -2826,8 +2932,8 @@      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+      let renamed = tmRenamedSource t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 6) parsed@@ -2854,7 +2960,7 @@      it "renames an exported data type" $ do       t <- ct $ parsedFileGhc "./Renaming/RenameInExportedType2.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (6, 24) parsed@@ -2880,7 +2986,7 @@      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+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (10, 10) parsed@@ -2906,7 +3012,7 @@      it "renames a class op signature" $ do       t <- ct $ parsedFileGhc "./Renaming/D4.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (13, 5) parsed@@ -2933,7 +3039,7 @@      it "renames a data decl parameter" $ do       t <- ct $ parsedFileGhc "./Renaming/ConstructorIn3.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t           nm = initRdrNameMap t        let Just n = locToNameRdrPure nm (9, 13) parsed@@ -2961,7 +3067,7 @@   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+      let parsed  = GHC.pm_parsed_source $ tmParsedModule t           nm      = initRdrNameMap t        let Just n = locToNameRdrPure nm (7, 1) parsed@@ -3124,24 +3230,24 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t+      let renamed = tmRenamedSource 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 parsed = GHC.pm_parsed_source $ tmParsedModule t+      let renamed = tmRenamedSource 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 parsed = GHC.pm_parsed_source $ tmParsedModule t+      let renamed = tmRenamedSource t       let (Just (modName,_)) = getModuleName parsed        (modIsExported modName renamed) `shouldBe` False@@ -3180,13 +3286,10 @@         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 renamed2 = tmRenamedSource t2 -         -- let mn = locToName (4,1) renamed1-         -- let (Just (GHC.L _ _n)) = mn+         let parsed1 = GHC.pm_parsed_source $ tmParsedModule t1+         let parsed2 = GHC.pm_parsed_source $ tmParsedModule t2           let Just (modName,_) = getModuleName parsed1          let@@ -3199,6 +3302,8 @@       ((_r,_r2),s) <- ct $ runRefactGhc comp (initialState { rsModule = initRefactModule [] t1}) testOptions       -- ((_r,_r2),s) <- ct $ runRefactGhc comp (initialLogOnState { rsModule = initRefactModule [] t1}) testOptions +      -- putStrLn $ showAnnDataFromState s+       (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"      ------------------------------------@@ -3210,10 +3315,10 @@           clearParsedModule          t2 <- parseSourceFileTest "./DupDef/Dd3.hs"-         let renamed2 = fromJust $ GHC.tm_renamed_source t2+         let renamed2 = tmRenamedSource t2 -         let parsed1 = GHC.pm_parsed_source $ GHC.tm_parsed_module t1-         let parsed2 = GHC.pm_parsed_source $ GHC.tm_parsed_module t2+         let parsed1 = GHC.pm_parsed_source $ tmParsedModule t1+         let parsed2 = GHC.pm_parsed_source $ tmParsedModule t2           -- let mn = locToName (4,1) renamed1          -- let (Just (GHC.L _ _n)) = mn@@ -3349,9 +3454,9 @@        t <- ct $ parsedFileGhc "./Renaming/ConflictExport.hs"       let nm = initRdrNameMap t-      let parsed  = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed  = GHC.pm_parsed_source $ tmParsedModule t -      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t+      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ tmParsedModule t        -- Is this the right module?       let Just (modName,_) = getModuleName parsed@@ -3363,7 +3468,8 @@       -- new name is "Renaming.ConflictExport.fringe"       let newName = mkTestGhcName 1 (Just modu) "fringe" -      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      -- (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      (showGhc modu) `shouldBe` "Renaming.ConflictExport"       (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringe"        (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringe"@@ -3374,9 +3480,9 @@     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 parsed  = GHC.pm_parsed_source $ tmParsedModule t -      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ GHC.tm_parsed_module t+      let modu = GHC.ms_mod $ GHC.pm_mod_summary $ tmParsedModule t        -- Is this the right module?       let Just (modName,_) = getModuleName parsed@@ -3388,7 +3494,8 @@       -- new name is "Renaming.ConflictExport.fringe"       let newName = mkTestGhcName 1 (Just modu) "fringeOk" -      (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      -- (showGhcQual modu) `shouldBe` "main@main:Renaming.ConflictExport"+      (showGhc modu) `shouldBe` "Renaming.ConflictExport"       (showGhcQual newName) `shouldBe` "Renaming.ConflictExport.fringeOk"        (showGhcQual $ GHC.localiseName newName) `shouldBe` "fringeOk"@@ -3510,7 +3617,7 @@       let         comp = do -         let renamed1 = fromJust $ GHC.tm_renamed_source t+         let renamed1 = tmRenamedSource t          parsed <- getRefactParsed           let listModName  = GHC.mkModuleName "Data.List"@@ -3527,7 +3634,7 @@       t <- ct $ parsedFileGhc "./TypeUtils/JustImports.hs"       let         comp = do-         let renamed1 = fromJust $ GHC.tm_renamed_source t+         let renamed1 = tmRenamedSource t          parsed <- getRefactParsed           let listModName  = GHC.mkModuleName "Data.List"@@ -3586,7 +3693,7 @@         comp = do          (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/JustImports.hs"          -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1+         let renamed1 = tmRenamedSource t1           let modName  = GHC.mkModuleName "Data.Maybe"          itemName <- mkNewGhcName Nothing "fromJust"@@ -3626,7 +3733,7 @@         comp = do          (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"          -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1+         let renamed1 = tmRenamedSource t1           let modName  = GHC.mkModuleName "Data.Maybe"          itemName <- mkNewGhcName Nothing "isJust"@@ -3644,7 +3751,7 @@         comp = do          (t1,_toks1)  <- parseSourceFileTest "./TypeUtils/SelectivelyImports.hs"          -- clearParsedModule-         let renamed1 = fromJust $ GHC.tm_renamed_source t1+         let renamed1 = tmRenamedSource t1           let modName  = GHC.mkModuleName "Data.Maybe"          itemName <- mkNewGhcName Nothing "isJust"@@ -3680,7 +3787,7 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just nf = locToNameRdrPure nm (10,21) parsed@@ -3694,7 +3801,7 @@   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 parsed = GHC.pm_parsed_source $ tmParsedModule t       let nm = initRdrNameMap t        let Just n1 = locToNameRdrPure nm (3,6)  parsed@@ -3744,7 +3851,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t        let         comp = do@@ -3761,7 +3868,7 @@      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 parsed = GHC.pm_parsed_source $ tmParsedModule t        let         comp = do@@ -3773,7 +3880,7 @@        (showGhcQual (r,n)) `shouldBe` "(bar, bar)" -  -- ---------------------------------------+  -- ---------------------------------------------------------------------  myShow :: GHC.RdrName -> String myShow n = case n of

@@ -22,6 +22,7 @@ import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.MonadFunctions import Language.Haskell.Refact.Utils.TypeUtils+import Language.Haskell.Refact.Utils.Types import Language.Haskell.Refact.Utils.Utils import Language.Haskell.Refact.Utils.Variables @@ -41,7 +42,7 @@   describe "locToExp on ParsedSource" $ do     it "p:finds the largest leftmost expression contained in a given region #1" $ do       t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t        let (Just expr) = locToExp (7,7) (7,43) parsed :: Maybe (GHC.Located (GHC.HsExpr GHC.RdrName))       getLocatedStart expr `shouldBe` (7,9)@@ -50,7 +51,7 @@     it "p:finds the largest leftmost expression contained in a given region #2" $ do       -- ((_, _, mod), toks) <- parsedFileBGhc       t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let modu = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let modu = GHC.pm_parsed_source $ tmParsedModule t        let (Just expr) = locToExp (7,7) (7,41) modu :: Maybe (GHC.Located (GHC.HsExpr GHC.RdrName))       getLocatedStart expr `shouldBe` (7,12)@@ -58,7 +59,7 @@      it "finds the largest leftmost expression in RenamedSource" $ do       t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t+      let renamed = tmRenamedSource t        let (Just expr) = locToExp (7,7) (7,41) renamed :: Maybe (GHC.Located (GHC.HsExpr GHC.Name))       getLocatedStart expr `shouldBe` (7,12)@@ -68,7 +69,7 @@     it "r:finds the largest leftmost expression contained in a given region #1" $ do       -- ((_, Just renamed, _), toks) <- parsedFileBGhc       t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let renamed = fromJust $ GHC.tm_renamed_source t+      let renamed = tmRenamedSource t        let (Just expr) = locToExp (7,7) (7,43) renamed :: Maybe (GHC.Located (GHC.HsExpr GHC.Name))       getLocatedStart expr `shouldBe` (7,9)@@ -80,14 +81,14 @@     it "loads a file having the LANGUAGE CPP pragma" $ do       t <- ct $ parsedFileGhc "./BCpp.hs" -      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       (showGhc parsed) `shouldBe` "module BCpp where\nbob :: Int -> Int -> Int\nbob x y = x + y"       -- ---------------------------------     it "loads a file having a top comment and LANGUAGE CPP pragma" $ do       t <- ct $ parsedFileGhc "./BCppTC.hs" -      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       (showGhc parsed) `shouldBe` "module BCppTC where\nbob :: Int -> Int -> Int\nbob x y = x + y"       -- ---------------------------------@@ -149,6 +150,30 @@    -- ----------------------------------- +    it "loads a file without a cabal project" $ do++      tmp <- getTemporaryDirectory+      let testDir = tmp ++ "/hare-test-no-cabal"+          testFileName = testDir ++ "/Foo.hs"+          testFileContents = unlines+            [ "main = putStrLn \"helo\""+            , "x = 1"+            ]+      createDirectoryIfMissing True testDir+      writeFile testFileName testFileContents++      let+        comp = do+         parseSourceFileGhc testFileName+         tm <- getRefactTargetModule+         g <- clientModsAndFiles tm+         return g+      (mg,_s) <- cdAndDo testDir $ runRefactGhc comp initialState testOptions+      -- (mg,_s) <- cdAndDo testDir $ runRefactGhc comp initialLogOnState testOptions+      showGhc (map GM.mpModule mg) `shouldBe` "[]"++  -- -----------------------------------+     it "loads a series of files based on cabal3, which has a lib and an exe" $ do        currentDir <- getCurrentDirectory@@ -332,14 +357,14 @@   describe "getModuleName" $ do     it "returns a string for the module name if there is one" $ do       t <- ct $ parsedFileGhc "./TypeUtils/B.hs"-      let modu = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let modu = GHC.pm_parsed_source $ tmParsedModule t        let (Just (_modname,modNameStr)) = getModuleName modu       modNameStr `shouldBe` "TypeUtils.B"      it "returns Nothing for the module name otherwise" $ do       t <- ct $ parsedFileGhc "./NoMod.hs"-      let modu = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let modu = GHC.pm_parsed_source $ tmParsedModule t       getModuleName modu `shouldBe` Nothing    -- -------------------------------------------------------------------@@ -366,7 +391,7 @@          return g       (mg,_s) <- ct $ runRefactGhc comp initialState testOptions       -- (mg,_s) <- ct $ runRefactGhc comp initialLogOnState testOptions-      showGhc (map GM.mpModule mg) `shouldBe` "[Main, M3, M2]"+      (sort $ map (showGhc . GM.mpModule) mg) `shouldBe` ["M2", "M3", "Main"]      ------------------------------------ @@ -399,6 +424,38 @@      ------------------------------------ +    it "gets modules when loading without a cabal file" $ do++      tmp <- getTemporaryDirectory+      let testDir = tmp ++ "/hare-test-no-cabal-clientmodsandfiles"+          testFileBName   = testDir ++ "/B.hs"+          testFileFooName = testDir ++ "/Foo.hs"+          testFileBContents = unlines+            [ "module B where"+            , "y = 2"+            ]+          testFileFooContents = unlines+            [ "import B"+            , "main = putStrLn \"hello\""+            , "x = y + 1"+            ]+      createDirectoryIfMissing True testDir+      writeFile testFileBName testFileBContents+      writeFile testFileFooName testFileFooContents++      let+        comp = do+         parseSourceFileGhc "./Foo.hs" -- Load the file first+         parseSourceFileGhc "./B.hs" -- Load the file first+         tm <- getRefactTargetModule+         g <- clientModsAndFiles tm+         return g+      (mg,_s) <- cdAndDo testDir $ runRefactGhc comp initialState testOptions+      showGhc (map GM.mpModule mg) `shouldBe` "[]"+++    ------------------------------------+     it "gets modules for HaRe" $ do       {-       let@@ -483,10 +540,10 @@           return (pr,g)        ( (t, mg), _s) <- ct $ runRefactGhc comp initialState testOptions-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t        (show $ getModuleName parsed) `shouldBe` "Just (ModuleName \"S1\",\"S1\")"-      showGhc (map GM.mpModule mg) `shouldBe` "[Main, M3, M2]"+      (sort $ map (showGhc . GM.mpModule) mg) `shouldBe` ["M2", "M3", "Main"]      -- --------------------------------- @@ -500,10 +557,10 @@            return (pr,g)       ((t, mg ), _s) <- ct $ runRefactGhc comp initialState testOptions-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t        (show $ getModuleName parsed) `shouldBe` "Just (ModuleName \"S1\",\"S1\")"-      showGhc (map GM.mpModule mg) `shouldBe` "[Main, M3, M2]"+      (sort $ map (showGhc . GM.mpModule) mg) `shouldBe` ["M2", "M3", "Main"]      -- --------------------------------- @@ -517,7 +574,7 @@            return (pr,g)       ((t, mg), _s) <- ct $ runRefactGhc comp  initialState testOptions-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       (show $ getModuleName parsed) `shouldBe` "Just (ModuleName \"DupDef.Dd1\",\"DupDef.Dd1\")"       showGhc (map GM.mpModule mg) `shouldBe` "[DupDef.Dd2, DupDef.Dd3]" @@ -582,7 +639,7 @@     it "loads a file from a sub directory" $ do       t <- ct $ parsedFileGhc "./FreeAndDeclared/DeclareS.hs"       fileName <- canonicalizePath "./test/testdata/FreeAndDeclared/DeclareS.hs"-      let parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t+      let parsed = GHC.pm_parsed_source $ tmParsedModule t       let         comp = do           parseSourceFileGhc fileName

@@ -1,4 +1,4 @@-module FunIn6 where+module AddOneParameter.FunIn6 where  --Default parameters can be added to definition of functions and simple constants. 

@@ -1,4 +1,4 @@-module FunIn6 where+module AddOneParameter.FunIn6 where  --Default parameters can be added to definition of functions and simple constants. 

@@ -0,0 +1,5 @@+module AddParams2 where++collapse rightInner rightOuter = right+  where+    right           = (rightInner, rightOuter)

@@ -10,9 +10,7 @@ --show that lifting and demoting are not inverse.  main x y z = case x of-                0 -> addthree x y z  -                1 -> inc y        +                0 -> addthree x y z+                1 -> inc y                      where inc a =a+1 addthree a b c=a+b+c--  

@@ -15,5 +15,3 @@                      where inc a =a+1   where     addthree=x+y+z--

@@ -1,12 +0,0 @@-module Demote.D2 where--sq x = x ^pow--pow = 2--main = sumSquares [1..4]-  where-    --demote  'sumSquares' should fail as it used by module 'A2'.-    sumSquares (x:xs) = sq x + sumSquares xs-    sumSquares [] = 0-

@@ -0,0 +1,13 @@+module Demote.D2a where++--demote  'sumSquares' should fail as it used by module 'A2'.++sumSquares (x:xs) = sq x + sumSquares xs+sumSquares [] = 0++sq x = x ^pow ++pow = 2++main = sumSquares [1..4]+

@@ -0,0 +1,12 @@+module Demote.D2a where++sq x = x ^pow++pow = 2++main = sumSquares [1..4]+  where+    --demote  'sumSquares' should fail as it used by module 'A2'.+    sumSquares (x:xs) = sq x + sumSquares xs+    sumSquares [] = 0+

@@ -10,10 +10,8 @@ sumSquares x y = let sq 0=0                      sq z=z^pow                      pow=2-                 in sq x + sq y  -                    -         +                 in sq x + sq y++ anotherFun 0 y = sq y      where  sq x = x^2--  

@@ -16,5 +16,3 @@  anotherFun 0 y = sq y      where  sq x = x^2--

@@ -7,12 +7,11 @@ --In this example, demote the top level 'sq' to 'sumSquares' --This example also aims to test the split of type signature. -sumSquares x y = sq x + sq y       +sumSquares x y = sq x + sq y  sq,anotherFun :: Int -> Int sq 0 = 0-sq z = z^pow +sq z = z^pow    where  pow=2  anotherFun x = x^2- 

@@ -17,4 +17,3 @@ anotherFun :: Int -> Int  anotherFun x = x^2-

@@ -4,7 +4,7 @@  toplevel :: Integer -> Integer toplevel x = c * x- + c,d :: Integer c = 7 d = 9

@@ -4,7 +4,7 @@  toplevel :: Integer -> Integer toplevel x = c * x- + c,d :: Integer c = 7 d = 9