haskell-tools-refactor 0.1.2.0 → 0.1.3.0

raw patch · 13 files changed

+544/−461 lines, 13 filesdep −structural-traversaldep ~haskell-tools-astdep ~haskell-tools-ast-fromghcdep ~haskell-tools-ast-genPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: structural-traversal

Dependency ranges changed: haskell-tools-ast, haskell-tools-ast-fromghc, haskell-tools-ast-gen, haskell-tools-ast-trf, haskell-tools-prettyprint

API changes (from Hackage documentation)

Files

• Language/Haskell/Tools/Refactor.hs +18/−25
• Language/Haskell/Tools/Refactor/ASTDebug.hs +99/−38
• Language/Haskell/Tools/Refactor/ASTDebug/Instances.hs +125/−110
• Language/Haskell/Tools/Refactor/DebugGhcAST.hs +1/−2
• Language/Haskell/Tools/Refactor/ExtractBinding.hs +36/−29
• Language/Haskell/Tools/Refactor/GenerateExports.hs +21/−15
• Language/Haskell/Tools/Refactor/GenerateTypeSignature.hs +25/−20
• Language/Haskell/Tools/Refactor/OrganizeImports.hs +28/−19
• Language/Haskell/Tools/Refactor/RangeDebug.hs +24/−51
• Language/Haskell/Tools/Refactor/RangeDebug/Instances.hs +110/−108
• Language/Haskell/Tools/Refactor/RefactorBase.hs +26/−23
• Language/Haskell/Tools/Refactor/RenameDefinition.hs +25/−14
• haskell-tools-refactor.cabal +6/−7

@@ -4,6 +4,8 @@            , ScopedTypeVariables
            , BangPatterns
            , MultiWayIf
+           , FlexibleContexts
+           , TypeFamilies
            #-}
 module Language.Haskell.Tools.Refactor where
 
@@ -36,7 +38,6 @@ import Data.List
 import Data.List.Split
 import GHC.Generics hiding (moduleName)
-import Data.StructuralTraversal
 import qualified Data.Map as Map
 import Data.Maybe
 import Data.Typeable
@@ -68,10 +69,6 @@ 
 import Debug.Trace
     
-
-type TemplateWithNames = NodeInfo (SemanticInfo GHC.Name) SourceTemplate
-type TemplateWithTypes = NodeInfo (SemanticInfo GHC.Id) SourceTemplate
-
 data RefactorCommand = NoRefactor 
                      | OrganizeImports
                      | GenerateExports
@@ -80,7 +77,8 @@                      | ExtractBinding RealSrcSpan String
     deriving Show
 
-performCommand :: RefactorCommand -> Ann AST.Module TemplateWithTypes -> Ghc (Either String (Ann AST.Module TemplateWithTypes))
+performCommand :: (SemanticInfo' dom SameInfoModuleCls ~ AST.ModuleInfo n, DomGenerateExports dom, OrganizeImportsDomain dom n, DomainRenameDefinition dom, ExtractBindingDomain dom, GenerateSignatureDomain dom) 
+               => RefactorCommand -> Ann AST.Module dom SrcTemplateStage -> Ghc (Either String (Ann AST.Module dom SrcTemplateStage))
 performCommand rf mod = runRefactor mod $ selectCommand rf
   where selectCommand  NoRefactor = return
         selectCommand OrganizeImports = organizeImports
@@ -166,7 +164,7 @@        load LoadAllTargets
        getModSummary $ mkModuleName moduleName
     
-parseTyped :: ModSummary -> Ghc (Ann AST.Module TemplateWithTypes)
+parseTyped :: ModSummary -> Ghc (Ann AST.Module IdDom SrcTemplateStage)
 parseTyped modSum = do
   p <- parseModule modSum
   tc <- typecheckModule p
@@ -174,20 +172,20 @@       srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
   rangeToSource srcBuffer . cutUpRanges . fixRanges . placeComments (getNormalComments $ snd annots) 
     <$> (addTypeInfos (typecheckedSource tc) 
-           =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
+           =<< (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (ms_mod modSum) (pm_parsed_source p)
                    runTrf (fst annots) (getPragmaComments $ snd annots)
                      $ trfModuleRename (ms_mod $ modSum) parseTrf
                          (fromJust $ tm_renamed_source tc) 
                          (pm_parsed_source p)))
 
-parseRenamed :: ModSummary -> Ghc (Ann AST.Module TemplateWithNames)
+parseRenamed :: ModSummary -> Ghc (Ann AST.Module (Dom GHC.Name) SrcTemplateStage)
 parseRenamed modSum = do
   p <- parseModule modSum
   tc <- typecheckModule p
   let annots = pm_annotations p
       srcBuffer = fromJust $ ms_hspp_buf $ pm_mod_summary p
   rangeToSource srcBuffer . cutUpRanges . fixRanges . placeComments (getNormalComments $ snd annots) 
-    <$> (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
+    <$> (do parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (ms_mod modSum) (pm_parsed_source p)
             runTrf (fst annots) (getPragmaComments $ snd annots)
               $ trfModuleRename (ms_mod $ modSum) parseTrf
                   (fromJust $ tm_renamed_source tc) 
@@ -211,20 +209,22 @@     --liftIO $ putStrLn $ show (typecheckedSource t)
     liftIO $ putStrLn "=========== parsed:"
     --transformed <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
-    parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (pm_parsed_source p)
-    liftIO $ putStrLn $ rangeDebug parseTrf
+    parseTrf <- runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModule (ms_mod modSum) (pm_parsed_source p)
+    liftIO $ putStrLn $ srcInfoDebug parseTrf
     liftIO $ putStrLn "=========== typed:"
     transformed <- addTypeInfos (typecheckedSource t) =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename (ms_mod $ modSum) parseTrf (fromJust $ tm_renamed_source t) (pm_parsed_source p))
-    liftIO $ putStrLn $ rangeDebug transformed
+    liftIO $ putStrLn $ srcInfoDebug transformed
     liftIO $ putStrLn "=========== ranges fixed:"
     let commented = fixRanges $ placeComments (getNormalComments $ snd annots) transformed
-    liftIO $ putStrLn $ rangeDebug commented
+    liftIO $ putStrLn $ srcInfoDebug commented
     liftIO $ putStrLn "=========== cut up:"
     let cutUp = cutUpRanges commented
-    liftIO $ putStrLn $ templateDebug cutUp
+    liftIO $ putStrLn $ srcInfoDebug cutUp
+    liftIO $ putStrLn $ show $ getLocIndices cutUp
+    liftIO $ putStrLn $ show $ mapLocIndices (fromJust $ ms_hspp_buf $ pm_mod_summary p) (getLocIndices cutUp)
     liftIO $ putStrLn "=========== sourced:"
     let sourced = rangeToSource (fromJust $ ms_hspp_buf $ pm_mod_summary p) cutUp
-    liftIO $ putStrLn $ sourceTemplateDebug sourced
+    liftIO $ putStrLn $ srcInfoDebug sourced
     liftIO $ putStrLn "=========== pretty printed:"
     let prettyPrinted = prettyPrint sourced
     liftIO $ putStrLn prettyPrinted
@@ -232,7 +232,7 @@     case transformed of 
       Right correctlyTransformed -> do
         liftIO $ putStrLn "=========== transformed AST:"
-        liftIO $ putStrLn $ sourceTemplateDebug correctlyTransformed
+        liftIO $ putStrLn $ srcInfoDebug correctlyTransformed
         liftIO $ putStrLn "=========== transformed & prettyprinted:"
         let prettyPrinted = prettyPrint correctlyTransformed
         liftIO $ putStrLn prettyPrinted
@@ -241,13 +241,6 @@         liftIO $ putStrLn "==========="
         liftIO $ putStrLn transformProblem
         liftIO $ putStrLn "==========="
-    
-printSemaInfo :: (StructuralTraversable node, Outputable n) => node (NodeInfo (SemanticInfo n) src) -> Ghc (node (NodeInfo (SemanticInfo n) src))
-printSemaInfo = traverseUp (return ()) (return ()) (\n@(NodeInfo s _) -> liftIO (print s) >> return n)
-      
+  
 deriving instance Generic SrcSpan
 deriving instance (Generic sema, Generic src) => Generic (NodeInfo sema src)
-deriving instance Generic RangeTemplate
-deriving instance Generic (SemanticInfo n)
-deriving instance Generic SourceTemplate
-deriving instance Generic SpanInfo

@@ -7,9 +7,11 @@            , TypeFamilies
            , TemplateHaskell
            , OverloadedStrings
+           , ConstraintKinds
            , LambdaCase
            , ViewPatterns
            , ScopedTypeVariables
+           , UndecidableInstances
            #-}
 -- | A module for displaying the AST in a tree view.
 module Language.Haskell.Tools.Refactor.ASTDebug where
@@ -38,28 +40,51 @@ import Language.Haskell.Tools.Refactor.RangeDebug
 
 
-data DebugNode a = TreeNode { _nodeLabel :: String
-                            , _nodeSubtree :: TreeDebugNode a 
-                            }
-                 | SimpleNode { _nodeLabel :: String
-                              , _nodeValue :: String
+data DebugNode dom = TreeNode { _nodeLabel :: String
+                              , _nodeSubtree :: TreeDebugNode dom
                               }
-  deriving Show
+                   | SimpleNode { _nodeLabel :: String
+                                , _nodeValue :: String
+                                }
 
-data TreeDebugNode a
+deriving instance Domain dom => Show (DebugNode dom)
+
+data TreeDebugNode dom
   = TreeDebugNode { _nodeName :: String
-                  , _nodeInfo :: a
-                  , _children :: [DebugNode a]
+                  , _nodeInfo :: SemanticInfoType dom
+                  , _children :: [DebugNode dom]
                   }
-  deriving Show
 
+deriving instance Domain dom => Show (TreeDebugNode dom)
+
+data SemanticInfoType dom 
+  = DefaultInfoType { semaInfoTypeRng :: SrcSpan 
+                    }
+  | NameInfoType { semaInfoTypeName :: SemanticInfo' dom SameInfoNameCls
+                 , semaInfoTypeRng :: SrcSpan 
+                 }
+  | ExprInfoType { semaInfoTypeExpr :: SemanticInfo' dom SameInfoExprCls
+                 , semaInfoTypeRng :: SrcSpan
+                 }
+  | ImportInfoType { semaInfoTypeImport :: SemanticInfo' dom SameInfoImportCls
+                   , semaInfoTypeRng :: SrcSpan
+                   }
+  | ModuleInfoType { semaInfoTypeModule :: SemanticInfo' dom SameInfoModuleCls
+                   , semaInfoTypeRng :: SrcSpan
+                   }
+
+deriving instance Domain dom => Show (SemanticInfoType dom)
+
 makeReferences ''DebugNode
 makeReferences ''TreeDebugNode
 
-astDebug :: (InspectableName n, HasRange a, ASTDebug e a, a ~ (NodeInfo (SemanticInfo n) src)) => e a -> String
+type AssocSema dom = ( AssocData (SemanticInfo' dom SameInfoModuleCls), AssocData (SemanticInfo' dom SameInfoImportCls)
+                     , AssocData (SemanticInfo' dom SameInfoNameCls), AssocData (SemanticInfo' dom SameInfoExprCls) )
+
+astDebug :: (ASTDebug e dom st, AssocSema dom) => e dom st -> String
 astDebug ast = toList (astDebugToJson (astDebug' ast))
 
-astDebugToJson :: (InspectableName n, HasRange a, a ~ (NodeInfo (SemanticInfo n) src)) => [DebugNode a] -> Seq Char
+astDebugToJson :: AssocSema dom => [DebugNode dom] -> Seq Char
 astDebugToJson nodes = fromList "[ " >< childrenJson >< fromList " ]"
     where treeNodes = List.filter (\case TreeNode {} -> True; _ -> False) nodes
           childrenJson = case map debugTreeNode treeNodes of 
@@ -68,15 +93,15 @@           debugTreeNode (TreeNode "" s) = astDebugElemJson s
           debugTreeNode (TreeNode (dropWhile (=='_') -> l) s) = astDebugElemJson (nodeName .- (("<span class='astlab'>" ++ l ++ "</span>: ") ++) $ s)
 
-astDebugElemJson :: (InspectableName n, HasRange a, a ~ (NodeInfo (SemanticInfo n) src)) => TreeDebugNode a -> Seq Char
+astDebugElemJson :: AssocSema dom => TreeDebugNode dom -> Seq Char
 astDebugElemJson (TreeDebugNode name info children) 
   = fromList "{ \"text\" : \"" >< fromList name 
      >< fromList "\", \"state\" : { \"opened\" : true }, \"a_attr\" : { \"data-range\" : \"" 
-     >< fromList (shortShowSpan (getRange info))
+     >< fromList (shortShowSpan (semaInfoTypeRng info))
      >< fromList "\", \"data-elems\" : \"" 
      >< foldl (><) Seq.empty dataElems
      >< fromList "\", \"data-sema\" : \"" 
-     >< fromList (showSema (info ^. semanticInfo))
+     >< fromList (showSema info)
      >< fromList "\" }, \"children\" : " 
      >< astDebugToJson children >< fromList " }"
   where dataElems = catMaybes (map (\case SimpleNode l v -> Just (fromList (formatScalarElem l v)); _ -> Nothing) children)
@@ -88,25 +113,60 @@   assocName :: a -> String
   toAssoc :: a -> [(String, String)]
 
-instance InspectableName n => AssocData (SemanticInfo n) where
-  assocName NoSemanticInfo = "NoSemanticInfo"
+instance AssocSema dom => AssocData (SemanticInfoType dom) where
+  assocName s@(DefaultInfoType {}) = "NoSemanticInfo"
+  assocName s@(NameInfoType {}) = assocName (semaInfoTypeName s)
+  assocName s@(ExprInfoType {}) = assocName (semaInfoTypeExpr s)
+  assocName s@(ImportInfoType {}) = assocName (semaInfoTypeImport s)
+  assocName s@(ModuleInfoType {}) = assocName (semaInfoTypeModule s)
+
+  toAssoc s@(DefaultInfoType {}) = []
+  toAssoc s@(NameInfoType {}) = toAssoc (semaInfoTypeName s)
+  toAssoc s@(ExprInfoType {}) = toAssoc (semaInfoTypeExpr s)
+  toAssoc s@(ImportInfoType {}) = toAssoc (semaInfoTypeImport s)
+  toAssoc s@(ModuleInfoType {}) = toAssoc (semaInfoTypeModule s)
+
+
+instance AssocData ScopeInfo where
   assocName (ScopeInfo {}) = "ScopeInfo"
+  toAssoc (ScopeInfo locals) = [ ("namesInScope", inspectScope locals) ]
+
+instance InspectableName n => AssocData (NameInfo n) where
   assocName (NameInfo {}) = "NameInfo"
-  assocName (ModuleInfo {}) = "ModuleInfo"
-  assocName (ImportInfo {}) = "ImportInfo"
+  assocName (AmbiguousNameInfo {}) = "AmbiguousNameInfo"
+  assocName (ImplicitNameInfo {}) = "ImplicitNameInfo"
 
-  toAssoc NoSemanticInfo = []
-  toAssoc (ScopeInfo locals) = [ ("namesInScope", inspectScope locals) ]
   toAssoc (NameInfo locals defined nameInfo) = [ ("name", inspect nameInfo)
                                                , ("isDefined", show defined)
                                                , ("namesInScope", inspectScope locals) 
                                                ]
-  toAssoc (ModuleInfo mod imps) = [("moduleName", showSDocUnsafe (ppr mod))
-                                  ,("implicitImports", concat (intersperse ", " (map inspect imps)))]
+  toAssoc (AmbiguousNameInfo locals defined name _) = [ ("name", inspect name)
+                                                      , ("isDefined", show defined)
+                                                      , ("namesInScope", inspectScope locals) 
+                                                      ]
+  toAssoc (ImplicitNameInfo locals defined name) = [ ("name", name)
+                                                   , ("isDefined", show defined)
+                                                   , ("namesInScope", inspectScope locals) 
+                                                   ]
+instance AssocData CNameInfo where
+  assocName (CNameInfo {}) = "CNameInfo"
+  toAssoc (CNameInfo locals defined nameInfo) = [ ("name", inspect nameInfo)
+                                                , ("isDefined", show defined)
+                                                , ("namesInScope", inspectScope locals) 
+                                                ]
+
+instance InspectableName n => AssocData (ModuleInfo n) where
+  assocName (ModuleInfo {}) = "ModuleInfo"
+  toAssoc (ModuleInfo mod imps) = [ ("moduleName", showSDocUnsafe (ppr mod))
+                                  , ("implicitImports", concat (intersperse ", " (map inspect imps)))
+                                  ]
+  
+instance InspectableName n => AssocData (ImportInfo n) where
+  assocName (ImportInfo {}) = "ImportInfo"
   toAssoc (ImportInfo mod avail imported) = [ ("moduleName", showSDocUnsafe (ppr mod)) 
                                             , ("availableNames", concat (intersperse ", " (map inspect avail))) 
                                             , ("importedNames", concat (intersperse ", " (map inspect imported))) 
-                                            ]
+                                            ]                                            
 
 inspectScope :: InspectableName n => [[n]] -> String
 inspectScope = concat . intersperse " | " . map (concat . intersperse ", " . map inspect)
@@ -123,40 +183,41 @@ instance InspectableName GHC.Id where
   inspect name = showSDocUnsafe (ppr name) ++ "[" ++ show (getUnique name) ++ "] :: " ++ showSDocOneLine unsafeGlobalDynFlags (ppr (idType name))
 
-class ASTDebug e a where
-  astDebug' :: e a -> [DebugNode a]
-  default astDebug' :: (GAstDebug (Rep (e a)) a, Generic (e a)) => e a -> [DebugNode a]
+class (Domain dom, SourceInfo st) 
+         => ASTDebug e dom st where
+  astDebug' :: e dom st -> [DebugNode dom]
+  default astDebug' :: (GAstDebug (Rep (e dom st)) dom, Generic (e dom st)) => e dom st -> [DebugNode dom]
   astDebug' = gAstDebug . from
 
-class GAstDebug f a where 
-  gAstDebug :: f p -> [DebugNode a]
+class GAstDebug f dom where 
+  gAstDebug :: f p -> [DebugNode dom]
   
-instance GAstDebug V1 a where
+instance GAstDebug V1 dom where
   gAstDebug _ = error "GAstDebug V1"
   
-instance GAstDebug U1 a where
+instance GAstDebug U1 dom where
   gAstDebug U1 = []  
   
-instance (GAstDebug f a, GAstDebug g a) => GAstDebug (f :+: g) a where
+instance (GAstDebug f dom, GAstDebug g dom) => GAstDebug (f :+: g) dom where
   gAstDebug (L1 x) = gAstDebug x
   gAstDebug (R1 x) = gAstDebug x
   
-instance (GAstDebug f a, GAstDebug g a) => GAstDebug (f :*: g) a where
+instance (GAstDebug f dom, GAstDebug g dom) => GAstDebug (f :*: g) dom where
   gAstDebug (x :*: y) 
     = gAstDebug x ++ gAstDebug y
 
-instance {-# OVERLAPPING #-} ASTDebug e a => GAstDebug (K1 i (e a)) a where
+instance {-# OVERLAPPING #-} ASTDebug e dom st => GAstDebug (K1 i (e dom st)) dom where
   gAstDebug (K1 x) = astDebug' x
   
-instance {-# OVERLAPPABLE #-} Show x => GAstDebug (K1 i x) a where
+instance {-# OVERLAPPABLE #-} Show x => GAstDebug (K1 i x) dom where
   gAstDebug (K1 x) = [SimpleNode "" (show x)]
         
-instance (GAstDebug f a, Constructor c) => GAstDebug (M1 C c f) a where
+instance (GAstDebug f dom, Constructor c) => GAstDebug (M1 C c f) dom where
   gAstDebug c@(M1 x) = [TreeNode "" (TreeDebugNode (conName c) undefined (gAstDebug x))]
 
-instance (GAstDebug f a, Selector s) => GAstDebug (M1 S s f) a where
+instance (GAstDebug f dom, Selector s) => GAstDebug (M1 S s f) dom where
   gAstDebug s@(M1 x) = traversal&nodeLabel .= selName s $ gAstDebug x
 
 -- don't have to do anything with datatype metainfo
-instance GAstDebug f a => GAstDebug (M1 D t f) a where
+instance GAstDebug f dom => GAstDebug (M1 D t f) dom where
   gAstDebug (M1 x) = gAstDebug x

@@ -4,6 +4,7 @@            , StandaloneDeriving
            , DeriveGeneric
            , UndecidableInstances 
+           , TypeFamilies
            #-}
 module Language.Haskell.Tools.Refactor.ASTDebug.Instances where
 
@@ -15,121 +16,135 @@ import Language.Haskell.Tools.AST
 
 -- Annotations
-instance (ASTDebug e a, Show (e a)) => ASTDebug (Ann e) a where
-  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= a $ astDebug' e
-  
-instance (ASTDebug e a, Show (e a)) => ASTDebug (AnnList e) a where
-  astDebug' (AnnList a ls) = [TreeNode "" (TreeDebugNode "*" a (concatMap astDebug' ls))]
-  
-instance (ASTDebug e a, Show (e a)) => ASTDebug (AnnMaybe e) a where
-  astDebug' (AnnMaybe a e) = [TreeNode "" (TreeDebugNode "?" a (maybe [] astDebug' e))]
+instance {-# OVERLAPPING #-} (ASTDebug SimpleName dom st) => ASTDebug (Ann SimpleName) dom st where
+  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (NameInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
+
+instance {-# OVERLAPPING #-} (ASTDebug Expr dom st) => ASTDebug (Ann Expr) dom st where
+  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ExprInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
+
+instance {-# OVERLAPPING #-} (ASTDebug ImportDecl dom st) => ASTDebug (Ann ImportDecl) dom st where
+  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ImportInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
+
+instance {-# OVERLAPPING #-} (ASTDebug Module dom st) => ASTDebug (Ann Module) dom st where
+  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= (ModuleInfoType (a ^. semanticInfo) (getRange (a ^. sourceInfo))) $ astDebug' e
+
+instance {-# OVERLAPPABLE #-} (ASTDebug e dom st) => ASTDebug (Ann e) dom st where
+  astDebug' (Ann a e) = traversal&nodeSubtree&nodeInfo .= DefaultInfoType (getRange (a ^. sourceInfo)) $ astDebug' e
+
+instance (ASTDebug e dom st) => ASTDebug (AnnList e) dom st where
+  astDebug' (AnnList a ls) = [TreeNode "" (TreeDebugNode "*" (DefaultInfoType (getRange (a ^. sourceInfo))) (concatMap astDebug' ls))]
   
+instance (ASTDebug e dom st) => ASTDebug (AnnMaybe e) dom st where
+  astDebug' (AnnMaybe a e) = [TreeNode "" (TreeDebugNode "?" (DefaultInfoType (getRange (a ^. sourceInfo))) (maybe [] astDebug' e))]
+
 -- Modules
-instance (Generic a, Show a) => ASTDebug Module a
-instance (Generic a, Show a) => ASTDebug ModuleHead a
-instance (Generic a, Show a) => ASTDebug ExportSpecList a
-instance (Generic a, Show a) => ASTDebug ExportSpec a
-instance (Generic a, Show a) => ASTDebug IESpec a
-instance (Generic a, Show a) => ASTDebug SubSpec a
-instance (Generic a, Show a) => ASTDebug ModulePragma a
-instance (Generic a, Show a) => ASTDebug FilePragma a
-instance (Generic a, Show a) => ASTDebug ImportDecl a
-instance (Generic a, Show a) => ASTDebug ImportSpec a
-instance (Generic a, Show a) => ASTDebug ImportQualified a
-instance (Generic a, Show a) => ASTDebug ImportSource a
-instance (Generic a, Show a) => ASTDebug ImportSafe a
-instance (Generic a, Show a) => ASTDebug TypeNamespace a
-instance (Generic a, Show a) => ASTDebug ImportRenaming a
+instance (Domain dom, SourceInfo st) => ASTDebug Module dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ModuleHead dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ExportSpecList dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ExportSpec dom st
+instance (Domain dom, SourceInfo st) => ASTDebug IESpec dom st
+instance (Domain dom, SourceInfo st) => ASTDebug SubSpec dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ModulePragma dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FilePragma dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportDecl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportSpec dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportQualified dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportSource dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportSafe dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeNamespace dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ImportRenaming dom st
 
 -- Declarations
-instance (Generic a, Show a) => ASTDebug Decl a
-instance (Generic a, Show a) => ASTDebug ClassBody a
-instance (Generic a, Show a) => ASTDebug ClassElement a
-instance (Generic a, Show a) => ASTDebug DeclHead a
-instance (Generic a, Show a) => ASTDebug InstBody a
-instance (Generic a, Show a) => ASTDebug InstBodyDecl a
-instance (Generic a, Show a) => ASTDebug GadtConDecl a
-instance (Generic a, Show a) => ASTDebug GadtConType a
-instance (Generic a, Show a) => ASTDebug GadtField a
-instance (Generic a, Show a) => ASTDebug FunDeps a
-instance (Generic a, Show a) => ASTDebug FunDep a
-instance (Generic a, Show a) => ASTDebug ConDecl a
-instance (Generic a, Show a) => ASTDebug FieldDecl a
-instance (Generic a, Show a) => ASTDebug Deriving a
-instance (Generic a, Show a) => ASTDebug InstanceRule a
-instance (Generic a, Show a) => ASTDebug InstanceHead a
-instance (Generic a, Show a) => ASTDebug TypeEqn a
-instance (Generic a, Show a) => ASTDebug KindConstraint a
-instance (Generic a, Show a) => ASTDebug TyVar a
-instance (Generic a, Show a) => ASTDebug Type a
-instance (Generic a, Show a) => ASTDebug Kind a
-instance (Generic a, Show a) => ASTDebug Context a
-instance (Generic a, Show a) => ASTDebug Assertion a
-instance (Generic a, Show a) => ASTDebug Expr a
-instance (Generic a, Show a, ASTDebug expr a, Show (expr a), Generic (expr a)) => ASTDebug (Stmt' expr) a
-instance (Generic a, Show a) => ASTDebug CompStmt a
-instance (Generic a, Show a) => ASTDebug ValueBind a
-instance (Generic a, Show a) => ASTDebug Pattern a
-instance (Generic a, Show a) => ASTDebug PatternField a
-instance (Generic a, Show a) => ASTDebug Splice a
-instance (Generic a, Show a) => ASTDebug QQString a
-instance (Generic a, Show a) => ASTDebug Match a
-instance (Generic a, Show a, ASTDebug expr a, Show (expr a), Generic (expr a)) => ASTDebug (Alt' expr) a
-instance (Generic a, Show a) => ASTDebug Rhs a
-instance (Generic a, Show a) => ASTDebug GuardedRhs a
-instance (Generic a, Show a) => ASTDebug FieldUpdate a
-instance (Generic a, Show a) => ASTDebug Bracket a
-instance (Generic a, Show a) => ASTDebug TopLevelPragma a
-instance (Generic a, Show a) => ASTDebug Rule a
-instance (Generic a, Show a) => ASTDebug AnnotationSubject a
-instance (Generic a, Show a) => ASTDebug MinimalFormula a
-instance (Generic a, Show a) => ASTDebug ExprPragma a
-instance (Generic a, Show a) => ASTDebug SourceRange a
-instance (Generic a, Show a) => ASTDebug Number a
-instance (Generic a, Show a) => ASTDebug QuasiQuote a
-instance (Generic a, Show a) => ASTDebug RhsGuard a
-instance (Generic a, Show a) => ASTDebug LocalBind a
-instance (Generic a, Show a) => ASTDebug LocalBinds a
-instance (Generic a, Show a) => ASTDebug FixitySignature a
-instance (Generic a, Show a) => ASTDebug TypeSignature a
-instance (Generic a, Show a) => ASTDebug ListCompBody a
-instance (Generic a, Show a) => ASTDebug TupSecElem a
-instance (Generic a, Show a) => ASTDebug TypeFamily a
-instance (Generic a, Show a) => ASTDebug TypeFamilySpec a
-instance (Generic a, Show a) => ASTDebug InjectivityAnn a
-instance (Generic a, Show a, ASTDebug expr a, Show (expr a), Generic (expr a)) => ASTDebug (CaseRhs' expr) a
-instance (Generic a, Show a, ASTDebug expr a, Show (expr a), Generic (expr a)) => ASTDebug (GuardedCaseRhs' expr) a
-instance (Generic a, Show a) => ASTDebug PatternSynonym a
-instance (Generic a, Show a) => ASTDebug PatSynRhs a
-instance (Generic a, Show a) => ASTDebug PatSynLhs a
-instance (Generic a, Show a) => ASTDebug PatSynWhere a
-instance (Generic a, Show a) => ASTDebug PatternTypeSignature a
-instance (Generic a, Show a) => ASTDebug Role a
-instance (Generic a, Show a) => ASTDebug Cmd a
-instance (Generic a, Show a) => ASTDebug LanguageExtension a
-instance (Generic a, Show a) => ASTDebug MatchLhs a
+instance (Domain dom, SourceInfo st) => ASTDebug Decl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ClassBody dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ClassElement dom st
+instance (Domain dom, SourceInfo st) => ASTDebug DeclHead dom st
+instance (Domain dom, SourceInfo st) => ASTDebug InstBody dom st
+instance (Domain dom, SourceInfo st) => ASTDebug InstBodyDecl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug GadtConDecl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug GadtConType dom st
+instance (Domain dom, SourceInfo st) => ASTDebug GadtField dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FunDeps dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FunDep dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ConDecl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FieldDecl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Deriving dom st
+instance (Domain dom, SourceInfo st) => ASTDebug InstanceRule dom st
+instance (Domain dom, SourceInfo st) => ASTDebug InstanceHead dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeEqn dom st
+instance (Domain dom, SourceInfo st) => ASTDebug KindConstraint dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TyVar dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Type dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Kind dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Context dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Assertion dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Expr dom st
+instance (Domain dom, SourceInfo st) => ASTDebug (Stmt' Expr) dom st
+instance (Domain dom, SourceInfo st) => ASTDebug (Stmt' Cmd) dom st
+instance (Domain dom, SourceInfo st) => ASTDebug CompStmt dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ValueBind dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Pattern dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatternField dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Splice dom st
+instance (Domain dom, SourceInfo st) => ASTDebug QQString dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Match dom st
+instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (Alt' expr) dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Rhs dom st
+instance (Domain dom, SourceInfo st) => ASTDebug GuardedRhs dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FieldUpdate dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Bracket dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TopLevelPragma dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Rule dom st
+instance (Domain dom, SourceInfo st) => ASTDebug AnnotationSubject dom st
+instance (Domain dom, SourceInfo st) => ASTDebug MinimalFormula dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ExprPragma dom st
+instance (Domain dom, SourceInfo st) => ASTDebug SourceRange dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Number dom st
+instance (Domain dom, SourceInfo st) => ASTDebug QuasiQuote dom st
+instance (Domain dom, SourceInfo st) => ASTDebug RhsGuard dom st
+instance (Domain dom, SourceInfo st) => ASTDebug LocalBind dom st
+instance (Domain dom, SourceInfo st) => ASTDebug LocalBinds dom st
+instance (Domain dom, SourceInfo st) => ASTDebug FixitySignature dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeSignature dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ListCompBody dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TupSecElem dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeFamily dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeFamilySpec dom st
+instance (Domain dom, SourceInfo st) => ASTDebug InjectivityAnn dom st
+instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (CaseRhs' expr) dom st
+instance (Domain dom, SourceInfo st, ASTDebug expr dom st, Generic (expr dom st)) => ASTDebug (GuardedCaseRhs' expr) dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatternSynonym dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatSynRhs dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatSynLhs dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatSynWhere dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PatternTypeSignature dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Role dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Cmd dom st
+instance (Domain dom, SourceInfo st) => ASTDebug LanguageExtension dom st
+instance (Domain dom, SourceInfo st) => ASTDebug MatchLhs dom st
 
 -- Literal
-instance (Generic a, Show a) => ASTDebug Literal a
-instance (Generic a, Show a, ASTDebug k a, Show (k a), Generic (k a)) => ASTDebug (Promoted k) a
+instance (Domain dom, SourceInfo st) => ASTDebug Literal dom st
+instance (Domain dom, SourceInfo st, ASTDebug k dom st, Generic (k dom st)) => ASTDebug (Promoted k) dom st
 
 -- Base
-instance (Generic a, Show a) => ASTDebug Operator a
-instance (Generic a, Show a) => ASTDebug Name a
-instance (Generic a, Show a) => ASTDebug SimpleName a
-instance (Generic a, Show a) => ASTDebug UnqualName a
-instance (Generic a, Show a) => ASTDebug StringNode a
-instance (Generic a, Show a) => ASTDebug DataOrNewtypeKeyword a
-instance (Generic a, Show a) => ASTDebug DoKind a
-instance (Generic a, Show a) => ASTDebug TypeKeyword a
-instance (Generic a, Show a) => ASTDebug OverlapPragma a
-instance (Generic a, Show a) => ASTDebug CallConv a
-instance (Generic a, Show a) => ASTDebug ArrowAppl a
-instance (Generic a, Show a) => ASTDebug Safety a
-instance (Generic a, Show a) => ASTDebug ConlikeAnnot a
-instance (Generic a, Show a) => ASTDebug Assoc a
-instance (Generic a, Show a) => ASTDebug Precedence a
-instance (Generic a, Show a) => ASTDebug LineNumber a
-instance (Generic a, Show a) => ASTDebug PhaseControl a
-instance (Generic a, Show a) => ASTDebug PhaseNumber a
-instance (Generic a, Show a) => ASTDebug PhaseInvert a+instance (Domain dom, SourceInfo st) => ASTDebug Operator dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Name dom st
+instance (Domain dom, SourceInfo st) => ASTDebug SimpleName dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ModuleName dom st
+instance (Domain dom, SourceInfo st) => ASTDebug UnqualName dom st
+instance (Domain dom, SourceInfo st) => ASTDebug StringNode dom st
+instance (Domain dom, SourceInfo st) => ASTDebug DataOrNewtypeKeyword dom st
+instance (Domain dom, SourceInfo st) => ASTDebug DoKind dom st
+instance (Domain dom, SourceInfo st) => ASTDebug TypeKeyword dom st
+instance (Domain dom, SourceInfo st) => ASTDebug OverlapPragma dom st
+instance (Domain dom, SourceInfo st) => ASTDebug CallConv dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ArrowAppl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Safety dom st
+instance (Domain dom, SourceInfo st) => ASTDebug ConlikeAnnot dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Assoc dom st
+instance (Domain dom, SourceInfo st) => ASTDebug Precedence dom st
+instance (Domain dom, SourceInfo st) => ASTDebug LineNumber dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PhaseControl dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PhaseNumber dom st
+instance (Domain dom, SourceInfo st) => ASTDebug PhaseInvert dom st

@@ -7,6 +7,7 @@ 
 import Language.Haskell.Tools.Refactor.RangeDebug
 import Language.Haskell.Tools.AST.FromGHC.GHCUtils
+import Language.Haskell.Tools.AST (shortShowSpan)
 
 import GHC
 import HsSyn
@@ -33,8 +34,6 @@ 
 instance Show a => Show (Located a) where
   show (L l a) = "L(" ++ shortShowSpan l ++ ") (" ++ show a ++ ")"
-
-
 
 deriving instance Show (ABExport RdrName)
 deriving instance Show (AmbiguousFieldOcc RdrName)

@@ -1,8 +1,11 @@ 
 {-# LANGUAGE ViewPatterns
+           , ScopedTypeVariables
            , RankNTypes
            , FlexibleContexts
            , TypeApplications
+           , ConstraintKinds
+           , TypeFamilies
            #-}
 module Language.Haskell.Tools.Refactor.ExtractBinding where
 
@@ -25,34 +28,38 @@ 
 import Debug.Trace
 
-type STWithId = STWithNames GHC.Id
+type Ann' e dom = Ann e dom SrcTemplateStage 
+type AnnMaybe' e dom = AnnMaybe e dom SrcTemplateStage 
 
-extractBinding' :: RealSrcSpan -> String -> Ann Module STWithId -> RefactoredModule GHC.Id
+type ExtractBindingDomain dom = ( Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls)
+                                , HasScopeInfo (SemanticInfo' dom SameInfoExprCls) )
+
+extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> Ann' Module dom -> RefactoredModule dom
 extractBinding' sp name mod
   = if isValidBindingName name then extractBinding (nodesContaining sp) (nodesContaining sp) name mod
                                else refactError "The given name is not a valid for the extracted binding"
 
-extractBinding :: Simple Traversal (Ann Module STWithId) (Ann ValueBind STWithId)
-                   -> Simple Traversal (Ann ValueBind STWithId) (Ann Expr STWithId)
-                   -> String -> Ann Module STWithId -> RefactoredModule GHC.Id
+extractBinding :: forall dom . ExtractBindingDomain dom => Simple Traversal (Ann' Module dom) (Ann' ValueBind dom)
+                   -> Simple Traversal (Ann' ValueBind dom) (Ann' Expr dom)
+                   -> String -> Ann' Module dom -> RefactoredModule dom
 extractBinding selectDecl selectExpr name mod
-  = let conflicting = any @[] (isConflicting name) (mod ^? selectDecl & biplateRef)
-        exprRange = head (mod ^? selectDecl & selectExpr & annotation & sourceInfo & sourceTemplateRange)
+  = let conflicting = any (isConflicting name) (mod ^? selectDecl & biplateRef :: [Ann' SimpleName dom])
+        exprRange = getRange $ head (mod ^? selectDecl & selectExpr & annotation & sourceInfo)
         decl = last (mod ^? selectDecl)
-        declRange = last (mod ^? selectDecl & annotation & sourceInfo & sourceTemplateRange)
+        declRange = getRange $ last (mod ^? selectDecl & annotation & sourceInfo)
      in if conflicting
            then refactError "The given name causes name conflict."
            else do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind name (head $ decl ^? actualContainingExpr exprRange) $ mod) Nothing
                    case st of Just def -> return $ evalState (selectDecl&element !~ addLocalBinding declRange exprRange def $ res) False
                               Nothing -> refactError "There is no applicable expression to extract."
 
-isConflicting :: String -> Ann SimpleName STWithId -> Bool
+isConflicting :: ExtractBindingDomain dom => String -> Ann' SimpleName dom -> Bool
 isConflicting name used
-  = (used ^? semantics & isDefined) == Just True
-      && (GHC.occNameString . GHC.getOccName <$> (used ^? semantics & nameInfo)) == Just name
+  = semanticsDefining (used ^. semantics)
+      && (GHC.occNameString . GHC.getOccName <$> semanticsName (used ^. semantics)) == Just name
 
 -- Replaces the selected expression with a call and generates the called binding.
-extractThatBind :: String -> Ann Expr STWithId -> Ann Expr STWithId -> StateT (Maybe (Ann ValueBind STWithId)) (Refactor GHC.Id) (Ann Expr STWithId)
+extractThatBind :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (Refactor dom) (Ann' Expr dom)
 extractThatBind name cont e 
   = do ret <- get
        if (isJust ret) then return e 
@@ -64,7 +71,7 @@             el -> doExtract name cont e
   where hasParameter = not (null (getExternalBinds cont e))
 
-addLocalBinding :: SrcSpan -> SrcSpan -> Ann ValueBind STWithId -> ValueBind STWithId -> State Bool (ValueBind STWithId)
+addLocalBinding :: SrcSpan -> SrcSpan -> Ann' ValueBind dom -> ValueBind dom SrcTemplateStage -> State Bool (ValueBind dom SrcTemplateStage)
 addLocalBinding declRange exprRange local bind 
   = do done <- get
        if not done then do put True
@@ -75,7 +82,7 @@     doAddBinding declRng (RealSrcSpan rng) local fb@(FunBind {}) 
       = funBindMatches & annList & filtered (isInside rng) & element & matchBinds .- insertLocalBind declRng local $ fb
 
-insertLocalBind :: SrcSpan -> Ann ValueBind STWithId -> AnnMaybe LocalBinds STWithId -> AnnMaybe LocalBinds STWithId
+insertLocalBind :: SrcSpan -> Ann' ValueBind dom -> AnnMaybe' LocalBinds dom -> AnnMaybe' LocalBinds dom
 insertLocalBind declRng toInsert locals 
   | isAnnNothing locals
   , RealSrcSpan rng <- declRng = -- creates the new where clause indented 2 spaces from the declaration
@@ -83,7 +90,7 @@   | otherwise = annJust & element & localBinds .- insertWhere (mkLocalValBind toInsert) (const True) isNothing $ locals
 
 -- | All expressions that are bound stronger than function application.
-isParenLikeExpr :: Expr a -> Bool
+isParenLikeExpr :: Expr dom st -> Bool
 isParenLikeExpr (If {}) = True
 isParenLikeExpr (Paren {}) = True
 isParenLikeExpr (List {}) = True
@@ -101,7 +108,7 @@ isParenLikeExpr (QuasiQuoteExpr {}) = True
 isParenLikeExpr _ = False
 
-doExtract :: String -> Ann Expr STWithId -> Ann Expr STWithId -> StateT (Maybe (Ann ValueBind STWithId)) (Refactor GHC.Id) (Ann Expr STWithId)
+doExtract :: ExtractBindingDomain dom => String -> Ann' Expr dom -> Ann' Expr dom -> StateT (Maybe (Ann' ValueBind dom)) (Refactor dom) (Ann' Expr dom)
 doExtract name cont e@((^. element) -> lam@(Lambda {}))
   = do let params = getExternalBinds cont e
        put (Just (generateBind name (map mkVarPat params ++ (lam ^? exprBindings&annList)) (fromJust $ lam ^? exprInner)))
@@ -112,42 +119,42 @@        return (generateCall name params)
 
 -- | Gets the values that have to be passed to the extracted definition
-getExternalBinds :: Ann Expr STWithId -> Ann Expr STWithId -> [Ann Name STWithId]
+getExternalBinds :: ExtractBindingDomain dom => Ann' Expr dom -> Ann' Expr dom -> [Ann' Name dom]
 getExternalBinds cont expr = map exprToName $ keepFirsts $ filter isApplicableName (expr ^? uniplateRef)
-  where isApplicableName name@(fmap GHC.varName . getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
+  where isApplicableName name@(getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
         isApplicableName _ = False
 
-        getExprNameInfo :: Ann Expr STWithId -> Maybe GHC.Var
-        getExprNameInfo expr = (listToMaybe $ expr ^? element & (exprName&element&simpleName &+& exprOperator&element&operatorName) 
-                                                              & semantics&nameInfo)
+        getExprNameInfo :: ExtractBindingDomain dom => Ann' Expr dom -> Maybe GHC.Name
+        getExprNameInfo expr = semanticsName =<< (listToMaybe $ expr ^? element & (exprName&element&simpleName &+& exprOperator&element&operatorName) 
+                                                                                & semantics)
 
         -- | Creates the parameter value to pass the name (operators are passed in parentheses)
-        exprToName :: Ann Expr STWithId -> Ann Name STWithId
+        exprToName :: Ann' Expr dom -> Ann' Name dom
         exprToName e | Just n <- e ^? element & exprName                               = n
                      | Just op <- e ^? element & exprOperator & element & operatorName = mkParenName op
         
         notInScopeForExtracted :: GHC.Name -> Bool
-        notInScopeForExtracted n = notElem @[] n (cont ^? semantics & scopedLocals & traversal & traversal)
+        notInScopeForExtracted n = notElem @[] n (semanticsScope (cont ^. semantics) ^? traversal & traversal)
 
         inScopeForOriginal :: GHC.Name -> Bool
-        inScopeForOriginal n = elem @[] n (expr ^? semantics & scopedLocals & traversal & traversal)
+        inScopeForOriginal n = elem @[] n (semanticsScope (expr ^. semantics) ^? traversal & traversal)
 
         keepFirsts (e:rest) = e : keepFirsts (filter (/= e) rest)
         keepFirsts [] = []
 
-actualContainingExpr :: SrcSpan -> Simple Traversal (Ann ValueBind STWithId) (Ann Expr STWithId)
+actualContainingExpr :: SourceInfo st => SrcSpan -> Simple Traversal (Ann ValueBind dom st) (Ann Expr dom st)
 actualContainingExpr (RealSrcSpan rng) = element & accessRhs & element & accessExpr
-  where accessRhs :: Simple Traversal (ValueBind STWithId) (Ann Rhs STWithId)
+  where accessRhs :: SourceInfo st => Simple Traversal (ValueBind dom st) (Ann Rhs dom st)
         accessRhs = valBindRhs &+& funBindMatches & annList & filtered (isInside rng) & element & matchRhs
-        accessExpr :: Simple Traversal (Rhs STWithId) (Ann Expr STWithId)
+        accessExpr :: SourceInfo st => Simple Traversal (Rhs dom st) (Ann Expr dom st)
         accessExpr = rhsExpr &+& rhsGuards & annList & filtered (isInside rng) & element & guardExpr
 
 -- | Generates the expression that calls the local binding
-generateCall :: String -> [Ann Name STWithId] -> Ann Expr STWithId
+generateCall :: String -> [Ann' Name dom] -> Ann' Expr dom
 generateCall name args = foldl (\e a -> mkApp e (mkVar a)) (mkVar $ mkNormalName $ mkSimpleName name) args
 
 -- | Generates the local binding for the selected expression
-generateBind :: String -> [Ann Pattern STWithId] -> Ann Expr STWithId -> Ann ValueBind STWithId
+generateBind :: String -> [Ann' Pattern dom] -> Ann' Expr dom -> Ann' ValueBind dom
 generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
 generateBind name args e = mkFunctionBind [mkMatch (mkNormalMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]
 

@@ -1,4 +1,8 @@-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TupleSections
+           , ConstraintKinds
+           , TypeFamilies
+           , FlexibleContexts
+           #-}
 module Language.Haskell.Tools.Refactor.GenerateExports where
 
 import Control.Reference hiding (element)
@@ -12,36 +16,38 @@ import Language.Haskell.Tools.AST.Gen
 import Language.Haskell.Tools.Refactor.RefactorBase
 
+type DomGenerateExports dom = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls))
+
 -- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
-generateExports :: GHC.NamedThing n => Ann Module (STWithNames n) -> RefactoredModule n
+generateExports :: DomGenerateExports dom => Ann Module dom SrcTemplateStage -> RefactoredModule dom
 generateExports mod = return (element & modHead & annJust & element & mhExports & annMaybe .= Just (createExports (getTopLevels mod)) $ mod)
 
 -- | Get all the top-level definitions with flags that mark if they can contain other top-level definitions 
 -- (classes and data declarations).
-getTopLevels :: Ann Module (STWithNames n) -> [(n, Bool)]
+getTopLevels :: DomGenerateExports dom => Ann Module dom SrcTemplateStage -> [(GHC.Name, Bool)]
 getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d) (getTopLevelDeclName d)) (mod ^? element & modDecl & annList & element)
-  where exportContainOthers :: Decl (STWithNames n) -> Bool
+  where exportContainOthers :: Decl dom SrcTemplateStage -> Bool
         exportContainOthers (DataDecl {}) = True
         exportContainOthers (ClassDecl {}) = True
         exportContainOthers _ = False
 
 -- | Get all the standalone top level definitions (their GHC unique names) in a module. 
 -- You could also do getting all the names with a biplate reference and select the top-level ones, but this is more efficient.
-getTopLevelDeclName :: Decl (NodeInfo (SemanticInfo n) src) -> Maybe n
-getTopLevelDeclName (d @ TypeDecl {}) = listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ TypeFamilyDecl {}) = listToMaybe (d ^? declTypeFamily & element & tfHead & dhNames)
-getTopLevelDeclName (d @ ClosedTypeFamilyDecl {}) = listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ DataDecl {}) = listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ GDataDecl {}) = listToMaybe (d ^? declHead & dhNames)
-getTopLevelDeclName (d @ ClassDecl {}) = listToMaybe (d ^? declHead & dhNames)
+getTopLevelDeclName :: DomGenerateExports dom => Decl dom SrcTemplateStage -> Maybe GHC.Name
+getTopLevelDeclName (d @ TypeDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
+getTopLevelDeclName (d @ TypeFamilyDecl {}) = semanticsName =<< listToMaybe (d ^? declTypeFamily & element & tfHead & dhNames)
+getTopLevelDeclName (d @ ClosedTypeFamilyDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
+getTopLevelDeclName (d @ DataDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
+getTopLevelDeclName (d @ GDataDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
+getTopLevelDeclName (d @ ClassDecl {}) = semanticsName =<< listToMaybe (d ^? declHead & dhNames)
 getTopLevelDeclName (d @ PatternSynonymDecl {}) 
-  = listToMaybe (d ^? declPatSyn & element & patLhs & element & (patName & element & simpleName &+& patSynOp & element & operatorName) & semantics & nameInfo)
-getTopLevelDeclName (d @ ValueBinding {}) = listToMaybe (d ^? declValBind & bindingName)
-getTopLevelDeclName (d @ ForeignImport {}) = listToMaybe (d ^? declName & element & simpleName & semantics & nameInfo)
+  = semanticsName =<< listToMaybe (d ^? declPatSyn & element & patLhs & element & (patName & element & simpleName &+& patSynOp & element & operatorName) & semantics)
+getTopLevelDeclName (d @ ValueBinding {}) = semanticsName =<< listToMaybe (d ^? declValBind & bindingName)
+getTopLevelDeclName (d @ ForeignImport {}) = semanticsName =<< listToMaybe (d ^? declName & element & simpleName & semantics)
 getTopLevelDeclName _ = Nothing
 
 -- | Create the export for a give name.
-createExports :: GHC.NamedThing n => [(n, Bool)] -> Ann ExportSpecList (STWithNames n)
+createExports :: DomGenerateExports dom => [(GHC.Name, Bool)] -> Ann ExportSpecList dom SrcTemplateStage
 createExports elems = mkExportSpecList $ map (mkExportSpec . createExport) elems
   where createExport (n, False) = mkIeSpec (mkUnqualName' (GHC.getName n)) Nothing
         createExport (n, True)  = mkIeSpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)

@@ -2,8 +2,11 @@            , FlexibleContexts
            , ScopedTypeVariables
            , RankNTypes 
+           , TypeApplications
+           , TypeFamilies
+           , ConstraintKinds
            #-}
-module Language.Haskell.Tools.Refactor.GenerateTypeSignature (generateTypeSignature, generateTypeSignature') where
+module Language.Haskell.Tools.Refactor.GenerateTypeSignature (generateTypeSignature, generateTypeSignature', GenerateSignatureDomain) where
 
 import GHC hiding (Module)
 import Type as GHC
@@ -26,34 +29,36 @@ import Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.Refactor.RefactorBase
 
-type RefactorId = Refactor GHC.Id
-type STWithId = STWithNames GHC.Id
+type Ann' e dom = Ann e dom SrcTemplateStage
+type AnnList' e dom = AnnList e dom SrcTemplateStage
+type GenerateSignatureDomain dom = ( Domain dom, HasIdInfo (SemanticInfo' dom SameInfoNameCls), Eq (SemanticInfo' dom SameInfoNameCls)
+                                   , SemanticInfo' dom SameInfoImportCls ~ ImportInfo Id ) 
 
-generateTypeSignature' :: RealSrcSpan -> Ann Module STWithId -> RefactoredModule GHC.Id
+generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> Ann' Module dom -> RefactoredModule dom
 generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp) 
 
 -- | Perform the refactoring on either local or top-level definition
-generateTypeSignature :: Simple Traversal (Ann Module STWithId) (AnnList Decl STWithId) 
+generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Ann' Module dom) (AnnList' Decl dom) 
                                 -- ^ Access for a top-level definition if it is the selected definition
-                           -> Simple Traversal (Ann Module STWithId) (AnnList LocalBind STWithId) 
+                           -> Simple Traversal (Ann' Module dom) (AnnList' LocalBind dom) 
                                 -- ^ Access for a definition list if it contains the selected definition
-                           -> (forall d . (Show (d (NodeInfo STWithId SourceTemplate)), Data (d STWithId), Typeable d, BindingElem d) 
-                                => AnnList d STWithId -> Maybe (Ann ValueBind STWithId)) 
+                           -> (forall d . (Show (d dom SrcTemplateStage), Data (d dom SrcTemplateStage), Typeable d, BindingElem d) 
+                                => AnnList' d dom -> Maybe (Ann' ValueBind dom)) 
                                 -- ^ Selector for either local or top-level declaration in the definition list
-                           -> Ann Module STWithId -> RefactoredModule GHC.Id
+                           -> Ann' Module dom -> RefactoredModule dom
 generateTypeSignature topLevelRef localRef vbAccess
   = flip evalStateT False .
      (topLevelRef !~ genTypeSig vbAccess
         <=< localRef !~ genTypeSig vbAccess)
   
-genTypeSig :: (Show (d (NodeInfo (SemanticInfo Id) SourceTemplate)), BindingElem d) => (AnnList d STWithId -> Maybe (Ann ValueBind STWithId))  
-                -> AnnList d STWithId -> StateT Bool RefactorId (AnnList d STWithId)
+genTypeSig :: (GenerateSignatureDomain dom, BindingElem d) => (AnnList' d dom -> Maybe (Ann' ValueBind dom))  
+                -> AnnList' d dom -> StateT Bool (Refactor dom) (AnnList' d dom)
 genTypeSig vbAccess ls 
   | Just vb <- vbAccess ls 
   , not (typeSignatureAlreadyExist ls vb)
     = do let id = getBindingName vb
              isTheBind (Just ((^.element) -> decl)) 
-               = isBinding decl && (decl ^? bindName) == (vb ^? bindingName :: [GHC.Id])
+               = isBinding decl && map semanticsId (decl ^? bindName) == map semanticsId (vb ^? bindingName)
              isTheBind _ = False
              
          alreadyGenerated <- get
@@ -65,11 +70,11 @@   | otherwise = return ls
 
 
-generateTSFor :: GHC.Name -> GHC.Type -> RefactorId (Ann TypeSignature STWithId)
+generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> Refactor dom (Ann' TypeSignature dom)
 generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
 
 -- | Generates the source-level type for a GHC internal type
-generateTypeFor :: Int -> GHC.Type -> RefactorId (Ann AST.Type STWithId) 
+generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> Refactor dom (Ann' AST.Type dom) 
 generateTypeFor prec t 
   -- context
   | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
@@ -112,25 +117,25 @@   | (tvs@(_:_), t') <- splitForAllTys t
   = wrapParen (-1) <$> (mkTyForall (mkTypeVarList (map getName tvs)) <$> generateTypeFor 0 t')
   | otherwise = error ("Cannot represent type: " ++ showSDocUnsafe (ppr t))
-  where wrapParen :: Int -> Ann AST.Type STWithId -> Ann AST.Type STWithId
+  where wrapParen :: Int -> Ann' AST.Type dom -> Ann' AST.Type dom
         wrapParen prec' node = if prec' < prec then mkTyParen node else node
 
         getTCId :: GHC.TyCon -> GHC.Id
         getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
 
-        generateAssertionFor :: GHC.Type -> RefactorId (Ann AST.Assertion STWithId)
+        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> Refactor dom (Ann' AST.Assertion dom)
         generateAssertionFor t 
           | Just (tc, types) <- splitTyConApp_maybe t
           = mkClassAssert <$> referenceName (getTCId tc) <*> mapM (generateTypeFor 0) types
         -- TODO: infix things
     
 -- | Check whether the definition already has a type signature
-typeSignatureAlreadyExist :: forall d . BindingElem d => AnnList d STWithId -> Ann ValueBind STWithId -> Bool
+typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList' d dom -> Ann' ValueBind dom -> Bool
 typeSignatureAlreadyExist ls vb = 
-  getBindingName vb `elem` concatMap (^? bindName) (filter isTypeSig $ ls ^? annList&element)
+  getBindingName vb `elem` catMaybes (map semanticsId $ concatMap (^? bindName) (filter isTypeSig $ ls ^? annList&element))
   
-getBindingName :: Ann ValueBind STWithId -> GHC.Id
-getBindingName vb = case nub $ vb ^? bindingName of 
+getBindingName :: GenerateSignatureDomain dom => Ann' ValueBind dom -> GHC.Id
+getBindingName vb = case catMaybes $ map semanticsId $ nub $ vb ^? bindingName of 
   [n] -> n
   [] -> error "Trying to generate a signature for a binding with no name"
   _ -> error "Trying to generate a signature for a binding with multiple names"

@@ -1,7 +1,10 @@ {-# LANGUAGE LambdaCase 
            , ScopedTypeVariables
+           , FlexibleContexts
+           , TypeFamilies
+           , ConstraintKinds
            #-}
-module Language.Haskell.Tools.Refactor.OrganizeImports (organizeImports) where
+module Language.Haskell.Tools.Refactor.OrganizeImports (organizeImports, OrganizeImportsDomain) where
 
 import SrcLoc
 import Name hiding (Name)
@@ -10,7 +13,7 @@ import TyCon
 import ConLike
 import DataCon
-import Outputable (ppr, showSDocUnsafe)
+import Outputable (Outputable(..), ppr, showSDocUnsafe)
 
 import Control.Reference hiding (element)
 import Control.Monad
@@ -21,7 +24,7 @@ import Data.Data
 import Data.List
 import Data.Generics.Uniplate.Data
-import Language.Haskell.Tools.AST
+import Language.Haskell.Tools.AST as AST
 import Language.Haskell.Tools.AST.FromGHC
 import Language.Haskell.Tools.AnnTrf.SourceTemplate
 import Language.Haskell.Tools.AnnTrf.SourceTemplateHelpers
@@ -31,27 +34,32 @@ import Language.Haskell.Tools.Refactor.RefactorBase
 import Debug.Trace
 
-organizeImports :: forall n . (NamedThing n, Data n) => Ann Module (STWithNames n) -> RefactoredModule n
+type OrganizeImportsDomain dom n = (Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, NamedThing n)
+
+organizeImports :: forall n dom . OrganizeImportsDomain dom n 
+                => Ann Module dom SrcTemplateStage -> RefactoredModule dom
 organizeImports mod
   = element&modImports&annListElems !~ narrowImports usedNames . sortImports $ mod
   where usedNames = map getName $ catMaybes
-                                $ map (^? (annotation&semanticInfo&nameInfo))
-                                $ (universeBi (mod ^. element&modHead) ++ universeBi (mod ^. element&modDecl) :: [Ann SimpleName (STWithNames n)])
+                                $ map (semanticsName . (^. (annotation&semanticInfo)))
+                                $ (universeBi (mod ^. element&modHead) ++ universeBi (mod ^. element&modDecl) :: [Ann SimpleName dom SrcTemplateStage])
         
 -- | Sorts the imports in alphabetical order
-sortImports :: [Ann ImportDecl (STWithNames n)] -> [Ann ImportDecl (STWithNames n)]
-sortImports = sortBy (ordByOccurrence `on` (^. element&importModule&element))
+sortImports :: [Ann ImportDecl dom SrcTemplateStage] -> [Ann ImportDecl dom SrcTemplateStage]
+sortImports = sortBy (compare `on` (^. element&importModule&element&AST.moduleNameString))
 
 -- | Modify an import to only import  names that are used.
-narrowImports :: forall n . NamedThing n => [GHC.Name] -> [Ann ImportDecl (STWithNames n)] -> Refactor n [Ann ImportDecl (STWithNames n)]
+narrowImports :: forall n dom . OrganizeImportsDomain dom n 
+              => [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage] -> Refactor dom [Ann ImportDecl dom SrcTemplateStage]
 narrowImports usedNames imps = foldM (narrowOneImport usedNames) imps imps 
-  where narrowOneImport :: [GHC.Name] -> [Ann ImportDecl (STWithNames n)] -> Ann ImportDecl (STWithNames n) -> Refactor n [Ann ImportDecl (STWithNames n)]
+  where narrowOneImport :: [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage] -> Ann ImportDecl dom SrcTemplateStage -> Refactor dom [Ann ImportDecl dom SrcTemplateStage]
         narrowOneImport names all one =
           (\case Just x -> map (\e -> if e == one then x else e) all
                  Nothing -> delete one all) <$> narrowImport names (map (^. semantics) all) one 
         
-narrowImport :: NamedThing n => [GHC.Name] -> [SemanticInfo n] -> Ann ImportDecl (STWithNames n) 
-                             -> Refactor n (Maybe (Ann ImportDecl (STWithNames n)))
+narrowImport :: OrganizeImportsDomain dom n
+             => [GHC.Name] -> [ImportInfo n] -> Ann ImportDecl dom SrcTemplateStage 
+                           -> Refactor dom (Maybe (Ann ImportDecl dom SrcTemplateStage))
 narrowImport usedNames otherModules imp
   | importIsExact (imp ^. element) 
   = Just <$> (element&importSpec&annJust&element&importSpecList !~ narrowImportSpecs usedNames $ imp)
@@ -65,29 +73,30 @@         Just importedMod = imp ^? annotation&semanticInfo&importedModule
     
 -- | Narrows the import specification (explicitely imported elements)
-narrowImportSpecs :: forall n . NamedThing n => [GHC.Name] -> AnnList IESpec (STWithNames n) -> Refactor n (AnnList IESpec (STWithNames n))
+narrowImportSpecs :: forall dom n . OrganizeImportsDomain dom n
+                  => [GHC.Name] -> AnnList IESpec dom SrcTemplateStage -> Refactor dom (AnnList IESpec dom SrcTemplateStage)
 narrowImportSpecs usedNames 
   = (annList&element !~ narrowSpecSubspec usedNames) 
        >=> return . filterList isNeededSpec
-  where narrowSpecSubspec :: [GHC.Name] -> IESpec (STWithNames n) -> Refactor n (IESpec (STWithNames n))
+  where narrowSpecSubspec :: [GHC.Name] -> IESpec dom SrcTemplateStage -> Refactor dom (IESpec dom SrcTemplateStage)
         narrowSpecSubspec usedNames spec 
-          = do let Just specName = spec ^? ieName&element&simpleName&annotation&semanticInfo&nameInfo
+          = do let Just specName = semanticsName =<< (spec ^? ieName&element&simpleName&annotation&semanticInfo)
                Just tt <- GHC.lookupName (getName specName)
                let subspecsInScope = case tt of ATyCon tc | not (isClassTyCon tc) 
                                                   -> map getName (tyConDataCons tc) `intersect` usedNames
                                                 _ -> usedNames
                ieSubspec&annJust !- narrowImportSubspecs subspecsInScope $ spec
   
-        isNeededSpec :: Ann IESpec (STWithNames n) -> Bool
+        isNeededSpec :: Ann IESpec dom SrcTemplateStage -> Bool
         isNeededSpec ie = 
           -- if the name is used, it is needed
-          fmap getName (ie ^? element&ieName&element&simpleName&annotation&semanticInfo&nameInfo) `elem` map Just usedNames
+          fmap getName (semanticsName =<< (ie ^? element&ieName&element&simpleName&annotation&semanticInfo)) `elem` map Just usedNames
           -- if the name is not used, but some of its constructors are used, it is needed
             || ((ie ^? element&ieSubspec&annJust&element&essList&annList) /= [])
             || (case ie ^? element&ieSubspec&annJust&element of Just SubSpecAll -> True; _ -> False)     
   
-narrowImportSubspecs :: NamedThing n => [GHC.Name] -> Ann SubSpec (STWithNames n) -> Ann SubSpec (STWithNames n)
+narrowImportSubspecs :: OrganizeImportsDomain dom n => [GHC.Name] -> Ann SubSpec dom SrcTemplateStage -> Ann SubSpec dom SrcTemplateStage
 narrowImportSubspecs [] (Ann _ SubSpecAll) = mkSubList []
 narrowImportSubspecs _ ss@(Ann _ SubSpecAll) = ss
 narrowImportSubspecs usedNames ss@(Ann _ (SubSpecList _)) 
-  = element&essList .- filterList (\n -> fmap getName (n ^? element&simpleName&annotation&semanticInfo&nameInfo) `elem` map Just usedNames) $ ss
+  = element&essList .- filterList (\n -> fmap getName (semanticsName =<< (n ^? element&simpleName&annotation&semanticInfo)) `elem` map Just usedNames) $ ss

@@ -18,63 +18,36 @@ import Language.Haskell.Tools.AnnTrf.RangeTemplate
 import Language.Haskell.Tools.AnnTrf.SourceTemplate
 
-rangeDebug :: (a ~ NodeInfo sema SpanInfo, TreeDebug e a) => e a -> String
-rangeDebug = treeDebug' (shortShowSpanInfo . (^. sourceInfo)) 0
-      
-shortShowSpanInfo :: SpanInfo -> String
-shortShowSpanInfo (NodeSpan sp) = shortShowSpan sp
-shortShowSpanInfo (OptionalPos bef aft loc) = "?" ++ show bef ++ " " ++ show aft ++ " " ++ shortShowLoc loc
-shortShowSpanInfo (ListPos bef aft sep _ loc) = "*" ++ show bef ++ " " ++ show sep ++ " " ++ show aft ++ " " ++ shortShowLoc loc
-      
-shortShowSpan :: SrcSpan -> String
-shortShowSpan (UnhelpfulSpan _) = "??-??" 
-shortShowSpan sp@(RealSrcSpan _) 
-  = shortShowLoc (srcSpanStart sp) ++ "-" ++ shortShowLoc (srcSpanEnd sp)
-      
-shortShowLoc :: SrcLoc -> String
-shortShowLoc (UnhelpfulLoc _) = "??"
-shortShowLoc (RealSrcLoc loc) = show (srcLocLine loc) ++ ":" ++ show (srcLocCol loc)
-      
-templateDebug :: TreeDebug e (NodeInfo sema RangeTemplate) => e (NodeInfo sema RangeTemplate) -> String
-templateDebug = treeDebug' (shortShowRangeTemplate . (^. sourceInfo)) 0
-
-shortShowRangeTemplate (RangeTemplate _ rngs) = "ˇ" ++ concatMap showRangeTemplateElem rngs ++ "ˇ"
-  where showRangeTemplateElem (RangeElem sp) = "[" ++ shortShowSpan (RealSrcSpan sp) ++ "]"
-        showRangeTemplateElem (RangeChildElem) = "."
-        showRangeTemplateElem r = show r
-
-sourceTemplateDebug :: TreeDebug e (NodeInfo sema SourceTemplate) => e (NodeInfo sema SourceTemplate) -> String
-sourceTemplateDebug = treeDebug' (shortShowSourceTemplate . (^. sourceInfo)) 0
-
-shortShowSourceTemplate temp = "ˇ" ++ (concatMap show $ temp ^. sourceTemplateElems) ++ "ˇ"
+srcInfoDebug :: TreeDebug e dom st => e dom st -> String
+srcInfoDebug = treeDebug' 0
       
-class TreeDebug e a where
-  treeDebug' :: (a -> String) -> Int -> e a -> String
-  default treeDebug' :: (GTreeDebug (Rep (e a)) a, Generic (e a)) => (a -> String) -> Int -> e a -> String
-  treeDebug' f i = gTreeDebug f i . from
+class (SourceInfo st, Domain dom, Show (e dom st))
+        => TreeDebug e dom st where
+  treeDebug' :: Int -> e dom st -> String
+  default treeDebug' :: (GTreeDebug (Rep (e dom st)), Generic (e dom st), Domain dom) => Int -> e dom st -> String
+  treeDebug' i = gTreeDebug i . from
 
-class GTreeDebug f a where 
-  gTreeDebug :: (a -> String) -> Int -> f p -> String
+class GTreeDebug f where 
+  gTreeDebug :: Int -> f p -> String
   
-instance GTreeDebug V1 a where
-  gTreeDebug _ _ _ = error "GTreeDebug V1"
+instance GTreeDebug V1 where
+  gTreeDebug _ = error "GTreeDebug V1"
   
-instance GTreeDebug U1 a where
-  gTreeDebug _ _ U1 = ""  
+instance GTreeDebug U1 where
+  gTreeDebug _ U1 = ""  
   
-instance (GTreeDebug f a, GTreeDebug g a) => GTreeDebug (f :+: g) a where
-  gTreeDebug f i (L1 x) = gTreeDebug f i x
-  gTreeDebug f i (R1 x) = gTreeDebug f i x
+instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :+: g) where
+  gTreeDebug i (L1 x) = gTreeDebug i x
+  gTreeDebug i (R1 x) = gTreeDebug i x
   
-instance (GTreeDebug f a, GTreeDebug g a) => GTreeDebug (f :*: g) a where
-  gTreeDebug f i (x :*: y) 
-    = gTreeDebug f i x ++ gTreeDebug f i y
+instance (GTreeDebug f, GTreeDebug g) => GTreeDebug (f :*: g) where
+  gTreeDebug i (x :*: y) = gTreeDebug i x ++ gTreeDebug i y
 
-instance {-# OVERLAPPING #-} TreeDebug e a => GTreeDebug (K1 i (e a)) a where
-  gTreeDebug f i (K1 x) = treeDebug' f i x
+instance {-# OVERLAPPING #-} TreeDebug e dom st => GTreeDebug (K1 i (e dom st)) where
+  gTreeDebug i (K1 x) = treeDebug' i x
   
-instance {-# OVERLAPPABLE #-} GTreeDebug (K1 i c) a where
-  gTreeDebug f i (K1 x) = ""
+instance {-# OVERLAPPABLE #-} GTreeDebug (K1 i c) where
+  gTreeDebug i (K1 x) = ""
         
-instance GTreeDebug f a => GTreeDebug (M1 i t f) a where
-  gTreeDebug f i (M1 x) = gTreeDebug f i x
+instance GTreeDebug f => GTreeDebug (M1 i t f) where
+  gTreeDebug i (M1 x) = gTreeDebug i x

@@ -10,128 +10,130 @@ import Language.Haskell.Tools.Refactor.RangeDebug
 
 import GHC.Generics
+import Control.Reference
 
 import Language.Haskell.Tools.AST
 
 -- Annotations
-instance (TreeDebug e a, Show (e a)) => TreeDebug (Ann e) a where
-  treeDebug' f i (Ann a e) = identLine i ++ f a ++ " " ++ take 40 (show e) ++ "..." ++ treeDebug' f (i+1) e
+instance TreeDebug e dom st => TreeDebug (Ann e) dom st where
+  treeDebug' i (Ann a e) = identLine i ++ show (a ^. sourceInfo) ++ " " ++ take 40 (show e) ++ "..." ++ treeDebug' (i+1) e
   
 identLine :: Int -> String
 identLine i = "\n" ++ replicate (i*2) ' '
   
-instance (TreeDebug e a, Show (e a)) => TreeDebug (AnnList e) a where
-  treeDebug' f i (AnnList a ls) = identLine i ++ f a ++ " <*>" ++ concatMap (treeDebug' f (i + 1)) ls 
+instance TreeDebug e dom st => TreeDebug (AnnList e) dom st where
+  treeDebug' i (AnnList a ls) = identLine i ++ show (a ^. sourceInfo) ++ " <*>" ++ concatMap (treeDebug' (i + 1)) ls 
   
-instance (TreeDebug e a, Show (e a)) => TreeDebug (AnnMaybe e) a where
-  treeDebug' f i (AnnMaybe a e) = identLine i ++ f a ++ " <?>" ++ maybe "" (\e -> treeDebug' f (i + 1) e) e
+instance TreeDebug e dom st => TreeDebug (AnnMaybe e) dom st where
+  treeDebug' i (AnnMaybe a e) = identLine i ++ show (a ^. sourceInfo) ++ " <?>" ++ maybe "" (\e -> treeDebug' (i + 1) e) e
   
 -- Modules
-instance (Generic a, Show a) => TreeDebug Module a
-instance (Generic a, Show a) => TreeDebug ModuleHead a
-instance (Generic a, Show a) => TreeDebug ExportSpecList a
-instance (Generic a, Show a) => TreeDebug ExportSpec a
-instance (Generic a, Show a) => TreeDebug IESpec a
-instance (Generic a, Show a) => TreeDebug SubSpec a
-instance (Generic a, Show a) => TreeDebug ModulePragma a
-instance (Generic a, Show a) => TreeDebug FilePragma a
-instance (Generic a, Show a) => TreeDebug ImportDecl a
-instance (Generic a, Show a) => TreeDebug ImportSpec a
-instance (Generic a, Show a) => TreeDebug ImportQualified a
-instance (Generic a, Show a) => TreeDebug ImportSource a
-instance (Generic a, Show a) => TreeDebug ImportSafe a
-instance (Generic a, Show a) => TreeDebug TypeNamespace a
-instance (Generic a, Show a) => TreeDebug ImportRenaming a
+instance (SourceInfo st, Domain dom) => TreeDebug Module dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ModuleHead dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ExportSpecList dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ExportSpec dom st
+instance (SourceInfo st, Domain dom) => TreeDebug IESpec dom st
+instance (SourceInfo st, Domain dom) => TreeDebug SubSpec dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ModulePragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FilePragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportDecl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportSpec dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportQualified dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportSource dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportSafe dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeNamespace dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ImportRenaming dom st
 
 -- Declarations
-instance (Generic a, Show a) => TreeDebug Decl a
-instance (Generic a, Show a) => TreeDebug ClassBody a
-instance (Generic a, Show a) => TreeDebug ClassElement a
-instance (Generic a, Show a) => TreeDebug DeclHead a
-instance (Generic a, Show a) => TreeDebug InstBody a
-instance (Generic a, Show a) => TreeDebug InstBodyDecl a
-instance (Generic a, Show a) => TreeDebug GadtConDecl a
-instance (Generic a, Show a) => TreeDebug GadtConType a
-instance (Generic a, Show a) => TreeDebug GadtField a
-instance (Generic a, Show a) => TreeDebug FunDeps a
-instance (Generic a, Show a) => TreeDebug FunDep a
-instance (Generic a, Show a) => TreeDebug ConDecl a
-instance (Generic a, Show a) => TreeDebug FieldDecl a
-instance (Generic a, Show a) => TreeDebug Deriving a
-instance (Generic a, Show a) => TreeDebug InstanceRule a
-instance (Generic a, Show a) => TreeDebug InstanceHead a
-instance (Generic a, Show a) => TreeDebug TypeEqn a
-instance (Generic a, Show a) => TreeDebug KindConstraint a
-instance (Generic a, Show a) => TreeDebug TyVar a
-instance (Generic a, Show a) => TreeDebug Type a
-instance (Generic a, Show a) => TreeDebug Kind a
-instance (Generic a, Show a) => TreeDebug Context a
-instance (Generic a, Show a) => TreeDebug Assertion a
-instance (Generic a, Show a) => TreeDebug Expr a
-instance (Generic a, Show a, TreeDebug expr a, Show (expr a), Generic (expr a)) => TreeDebug (Stmt' expr) a
-instance (Generic a, Show a) => TreeDebug CompStmt a
-instance (Generic a, Show a) => TreeDebug ValueBind a
-instance (Generic a, Show a) => TreeDebug Pattern a
-instance (Generic a, Show a) => TreeDebug PatternField a
-instance (Generic a, Show a) => TreeDebug Splice a
-instance (Generic a, Show a) => TreeDebug QQString a
-instance (Generic a, Show a) => TreeDebug Match a
-instance (Generic a, Show a, TreeDebug expr a, Show (expr a), Generic (expr a)) => TreeDebug (Alt' expr) a
-instance (Generic a, Show a) => TreeDebug Rhs a
-instance (Generic a, Show a) => TreeDebug GuardedRhs a
-instance (Generic a, Show a) => TreeDebug FieldUpdate a
-instance (Generic a, Show a) => TreeDebug Bracket a
-instance (Generic a, Show a) => TreeDebug TopLevelPragma a
-instance (Generic a, Show a) => TreeDebug Rule a
-instance (Generic a, Show a) => TreeDebug AnnotationSubject a
-instance (Generic a, Show a) => TreeDebug MinimalFormula a
-instance (Generic a, Show a) => TreeDebug ExprPragma a
-instance (Generic a, Show a) => TreeDebug SourceRange a
-instance (Generic a, Show a) => TreeDebug Number a
-instance (Generic a, Show a) => TreeDebug QuasiQuote a
-instance (Generic a, Show a) => TreeDebug RhsGuard a
-instance (Generic a, Show a) => TreeDebug LocalBind a
-instance (Generic a, Show a) => TreeDebug LocalBinds a
-instance (Generic a, Show a) => TreeDebug FixitySignature a
-instance (Generic a, Show a) => TreeDebug TypeSignature a
-instance (Generic a, Show a) => TreeDebug ListCompBody a
-instance (Generic a, Show a) => TreeDebug TupSecElem a
-instance (Generic a, Show a) => TreeDebug TypeFamily a
-instance (Generic a, Show a) => TreeDebug TypeFamilySpec a
-instance (Generic a, Show a) => TreeDebug InjectivityAnn a
-instance (Generic a, Show a, TreeDebug expr a, Show (expr a), Generic (expr a)) => TreeDebug (CaseRhs' expr) a
-instance (Generic a, Show a, TreeDebug expr a, Show (expr a), Generic (expr a)) => TreeDebug (GuardedCaseRhs' expr) a
-instance (Generic a, Show a) => TreeDebug PatternSynonym a
-instance (Generic a, Show a) => TreeDebug PatSynRhs a
-instance (Generic a, Show a) => TreeDebug PatSynLhs a
-instance (Generic a, Show a) => TreeDebug PatSynWhere a
-instance (Generic a, Show a) => TreeDebug PatternTypeSignature a
-instance (Generic a, Show a) => TreeDebug Role a
-instance (Generic a, Show a) => TreeDebug Cmd a
-instance (Generic a, Show a) => TreeDebug LanguageExtension a
-instance (Generic a, Show a) => TreeDebug MatchLhs a
+instance (SourceInfo st, Domain dom) => TreeDebug Decl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ClassBody dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ClassElement dom st
+instance (SourceInfo st, Domain dom) => TreeDebug DeclHead dom st
+instance (SourceInfo st, Domain dom) => TreeDebug InstBody dom st
+instance (SourceInfo st, Domain dom) => TreeDebug InstBodyDecl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug GadtConDecl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug GadtConType dom st
+instance (SourceInfo st, Domain dom) => TreeDebug GadtField dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FunDeps dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FunDep dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ConDecl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FieldDecl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Deriving dom st
+instance (SourceInfo st, Domain dom) => TreeDebug InstanceRule dom st
+instance (SourceInfo st, Domain dom) => TreeDebug InstanceHead dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeEqn dom st
+instance (SourceInfo st, Domain dom) => TreeDebug KindConstraint dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TyVar dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Type dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Kind dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Context dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Assertion dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Expr dom st
+instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (Stmt' expr) dom st
+instance (SourceInfo st, Domain dom) => TreeDebug CompStmt dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ValueBind dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Pattern dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatternField dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Splice dom st
+instance (SourceInfo st, Domain dom) => TreeDebug QQString dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Match dom st
+instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (Alt' expr) dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Rhs dom st
+instance (SourceInfo st, Domain dom) => TreeDebug GuardedRhs dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FieldUpdate dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Bracket dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TopLevelPragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Rule dom st
+instance (SourceInfo st, Domain dom) => TreeDebug AnnotationSubject dom st
+instance (SourceInfo st, Domain dom) => TreeDebug MinimalFormula dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ExprPragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug SourceRange dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Number dom st
+instance (SourceInfo st, Domain dom) => TreeDebug QuasiQuote dom st
+instance (SourceInfo st, Domain dom) => TreeDebug RhsGuard dom st
+instance (SourceInfo st, Domain dom) => TreeDebug LocalBind dom st
+instance (SourceInfo st, Domain dom) => TreeDebug LocalBinds dom st
+instance (SourceInfo st, Domain dom) => TreeDebug FixitySignature dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeSignature dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ListCompBody dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TupSecElem dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeFamily dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeFamilySpec dom st
+instance (SourceInfo st, Domain dom) => TreeDebug InjectivityAnn dom st
+instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (CaseRhs' expr) dom st
+instance (SourceInfo st, Domain dom, TreeDebug expr dom st, Generic (expr dom st)) => TreeDebug (GuardedCaseRhs' expr) dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatternSynonym dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatSynRhs dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatSynLhs dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatSynWhere dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PatternTypeSignature dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Role dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Cmd dom st
+instance (SourceInfo st, Domain dom) => TreeDebug LanguageExtension dom st
+instance (SourceInfo st, Domain dom) => TreeDebug MatchLhs dom st
 
 -- Literal
-instance (Generic a, Show a) => TreeDebug Literal a
-instance (Generic a, Show a, TreeDebug k a, Show (k a), Generic (k a)) => TreeDebug (Promoted k) a
+instance (SourceInfo st, Domain dom) => TreeDebug Literal dom st
+instance (SourceInfo st, Domain dom, TreeDebug k dom st, Generic (k dom st)) => TreeDebug (Promoted k) dom st
 
 -- Base
-instance (Generic a, Show a) => TreeDebug Operator a
-instance (Generic a, Show a) => TreeDebug Name a
-instance (Generic a, Show a) => TreeDebug SimpleName a
-instance (Generic a, Show a) => TreeDebug UnqualName a
-instance (Generic a, Show a) => TreeDebug StringNode a
-instance (Generic a, Show a) => TreeDebug DataOrNewtypeKeyword a
-instance (Generic a, Show a) => TreeDebug DoKind a
-instance (Generic a, Show a) => TreeDebug TypeKeyword a
-instance (Generic a, Show a) => TreeDebug OverlapPragma a
-instance (Generic a, Show a) => TreeDebug CallConv a
-instance (Generic a, Show a) => TreeDebug ArrowAppl a
-instance (Generic a, Show a) => TreeDebug Safety a
-instance (Generic a, Show a) => TreeDebug ConlikeAnnot a
-instance (Generic a, Show a) => TreeDebug Assoc a
-instance (Generic a, Show a) => TreeDebug Precedence a
-instance (Generic a, Show a) => TreeDebug LineNumber a
-instance (Generic a, Show a) => TreeDebug PhaseControl a
-instance (Generic a, Show a) => TreeDebug PhaseNumber a
-instance (Generic a, Show a) => TreeDebug PhaseInvert a+instance (SourceInfo st, Domain dom) => TreeDebug Operator dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Name dom st
+instance (SourceInfo st, Domain dom) => TreeDebug SimpleName dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ModuleName dom st
+instance (SourceInfo st, Domain dom) => TreeDebug UnqualName dom st
+instance (SourceInfo st, Domain dom) => TreeDebug StringNode dom st
+instance (SourceInfo st, Domain dom) => TreeDebug DataOrNewtypeKeyword dom st
+instance (SourceInfo st, Domain dom) => TreeDebug DoKind dom st
+instance (SourceInfo st, Domain dom) => TreeDebug TypeKeyword dom st
+instance (SourceInfo st, Domain dom) => TreeDebug OverlapPragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug CallConv dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ArrowAppl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Safety dom st
+instance (SourceInfo st, Domain dom) => TreeDebug ConlikeAnnot dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Assoc dom st
+instance (SourceInfo st, Domain dom) => TreeDebug Precedence dom st
+instance (SourceInfo st, Domain dom) => TreeDebug LineNumber dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PhaseControl dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PhaseNumber dom st
+instance (SourceInfo st, Domain dom) => TreeDebug PhaseInvert dom st

@@ -21,6 +21,7 @@ import Control.Reference hiding (element)
 import Data.Function (on)
 import Data.List
+import Data.List.Split
 import Data.Maybe
 import Data.Char
 import Control.Monad.Reader
@@ -28,25 +29,26 @@ import Control.Monad.Writer
 
 -- | The information a refactoring can use
-data RefactorCtx a = RefactorCtx { refModuleName :: GHC.Module
-                                 , refCtxImports :: [Ann ImportDecl a] 
-                                 }
+data RefactorCtx dom = RefactorCtx { refModuleName :: GHC.Module
+                                   , refCtxImports :: [Ann ImportDecl dom SrcTemplateStage] 
+                                   }
 
 -- | Performs the given refactoring, transforming it into a Ghc action
-runRefactor :: (a ~ STWithNames n, TemplateAnnot a) => Ann Module a -> (Ann Module a -> Refactor n (Ann Module a)) -> Ghc (Either String (Ann Module a))
+runRefactor :: (SemanticInfo' dom SameInfoModuleCls ~ ModuleInfo n) 
+            => Ann Module dom SrcTemplateStage -> (Ann Module dom SrcTemplateStage -> RefactoredModule dom) -> Ghc (Either String (Ann Module dom SrcTemplateStage))
 runRefactor mod trf = let init = RefactorCtx (fromJust $ mod ^? semantics&defModuleName) (mod ^? element&modImports&annList)
                        in runExceptT $ runReaderT (addGeneratedImports (runWriterT (fromRefactorT $ trf mod))) init
 
 -- | Adds the imports that bring names into scope that are needed by the refactoring
-addGeneratedImports :: (TemplateAnnot a, Monad m) => ReaderT (RefactorCtx a) m (Ann Module a, [GHC.Name]) -> ReaderT (RefactorCtx a) m (Ann Module a)
+addGeneratedImports :: (Monad m) => ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage, [GHC.Name]) -> ReaderT (RefactorCtx dom) m (Ann Module dom SrcTemplateStage)
 addGeneratedImports = 
   fmap (\(m,names) -> element&modImports&annListElems .- (++ addImports names) $ m)
-  where addImports :: TemplateAnnot a => [GHC.Name] -> [Ann ImportDecl a]
+  where addImports :: [GHC.Name] -> [Ann ImportDecl dom SrcTemplateStage]
         addImports names = map createImport $ groupBy ((==) `on` GHC.nameModule) $ nub $ sort names
 
         -- TODO: group names like constructors into correct IESpecs
-        createImport :: TemplateAnnot a => [GHC.Name] -> Ann ImportDecl a
-        createImport names = mkImportDecl False False False Nothing (mkSimpleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
+        createImport :: [GHC.Name] -> Ann ImportDecl dom SrcTemplateStage
+        createImport names = mkImportDecl False False False Nothing (mkModuleName $ GHC.moduleNameString $ GHC.moduleName $ GHC.nameModule $ head names)
                                           Nothing (Just $ mkImportSpecList (map (\n -> mkIeSpec (mkUnqualName' n) Nothing) names))
 
 instance (GhcMonad m, Monoid s) => GhcMonad (WriterT s m) where
@@ -75,21 +77,19 @@   
 
 -- | Input and output information for the refactoring
-newtype RefactorT ann m ast = RefactorT { fromRefactorT :: WriterT [GHC.Name] (ReaderT (RefactorCtx ann) m) ast }
-  deriving (Functor, Applicative, Monad, MonadReader (RefactorCtx ann), MonadWriter [GHC.Name], MonadIO, HasDynFlags, ExceptionMonad, GhcMonad)
+newtype RefactorT dom m a = RefactorT { fromRefactorT :: WriterT [GHC.Name] (ReaderT (RefactorCtx dom) m) a }
+  deriving (Functor, Applicative, Monad, MonadReader (RefactorCtx dom), MonadWriter [GHC.Name], MonadIO, HasDynFlags, ExceptionMonad, GhcMonad)
 
-instance MonadTrans (RefactorT ann) where
+instance MonadTrans (RefactorT dom) where
   lift = RefactorT . lift . lift
 
 refactError :: String -> Refactor n a
 refactError = lift . throwE
 
 -- | The refactoring monad
-type Refactor n = RefactorT (STWithNames n) (ExceptT String Ghc)
-
-type STWithNames n = NodeInfo (SemanticInfo n) SourceTemplate
+type Refactor dom = RefactorT dom (ExceptT String Ghc)
 
-type RefactoredModule n = Refactor n (Ann Module (STWithNames n))
+type RefactoredModule dom = Refactor dom (Ann Module dom SrcTemplateStage)
 
 registeredNamesFromPrelude :: [GHC.Name]
 registeredNamesFromPrelude = GHC.basicKnownKeyNames ++ map GHC.tyConName GHC.wiredInTyCons
@@ -105,14 +105,17 @@   Just mod -> GHC.moduleNameString (GHC.moduleName mod) ++ "." ++ GHC.occNameString (GHC.nameOccName name)
   Nothing -> GHC.occNameString (GHC.nameOccName name)
 
-referenceName :: (Eq n, GHC.NamedThing n) => n -> Refactor n (Ann Name (STWithNames n))
+referenceName :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
+              => n -> Refactor dom (Ann Name dom SrcTemplateStage)
 referenceName = referenceName' mkQualName'
 
-referenceOperator :: (Eq n, GHC.NamedThing n) => n -> Refactor n (Ann Operator (STWithNames n))
+referenceOperator :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
+                  => n -> Refactor dom (Ann Operator dom SrcTemplateStage)
 referenceOperator = referenceName' mkQualOp'
 
 -- | Create a name that references the definition. Generates an import if the definition is not yet imported.
-referenceName' :: (Eq n, GHC.NamedThing n) => ([String] -> GHC.Name -> Ann nt (STWithNames n)) -> n -> Refactor n (Ann nt (STWithNames n))
+referenceName' :: (SemanticInfo' dom SameInfoImportCls ~ ImportInfo n, Eq n, GHC.NamedThing n) 
+               => ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> n -> Refactor dom (Ann nt dom SrcTemplateStage)
 referenceName' makeName n@(GHC.getName -> name) 
   | name `elem` registeredNamesFromPrelude || qualifiedName name `elem` otherNamesFromPrelude
   = return $ makeName [] name -- imported from prelude
@@ -127,16 +130,16 @@                     else return $ referenceBy makeName name possibleImports -- use it according to the best available import
 
 -- | Reference the name by the shortest suitable import
-referenceBy :: (TemplateAnnot a) => ([String] -> GHC.Name -> Ann nt a) -> GHC.Name -> [Ann ImportDecl a] -> Ann nt a
+referenceBy :: ([String] -> GHC.Name -> Ann nt dom SrcTemplateStage) -> GHC.Name -> [Ann ImportDecl dom SrcTemplateStage] -> Ann nt dom SrcTemplateStage
 referenceBy makeName name imps = 
   let prefixes = map importQualifier imps
    in makeName (minimumBy (compare `on` (length . concat)) prefixes) name
-  where importQualifier :: Ann ImportDecl a -> [String]
+  where importQualifier :: Ann ImportDecl dom SrcTemplateStage -> [String]
         importQualifier imp 
           = if isJust (imp ^? element&importQualified&annJust) 
               then case imp ^? element&importAs&annJust&element&importRename&element of 
-                      Nothing -> nameElements (imp ^. element&importModule&element) -- fully qualified import
-                      Just asName -> nameElements asName -- the name given by as clause
+                      Nothing -> splitOn "." (imp ^. element&importModule&element&moduleNameString) -- fully qualified import
+                      Just asName -> splitOn "." (asName ^. moduleNameString) -- the name given by as clause
               else [] -- unqualified import
 
 -- | Different classes of definitions that have different kind of names.
@@ -147,7 +150,7 @@                | SynonymOperator  -- ^ Type definitions with operator-like names
 
 -- | Get which category does a given name belong to
-classifyName :: GHC.Name -> Refactor n NameClass
+classifyName :: GHC.Name -> Refactor dom NameClass
 classifyName n = lookupName n >>= return . \case 
     Just (AnId id) | isop     -> ValueOperator
     Just (AnId id)            -> Variable

@@ -1,16 +1,23 @@ {-# LANGUAGE ScopedTypeVariables
            , LambdaCase
            , MultiWayIf
+           , TypeApplications
+           , ConstraintKinds
+           , TypeFamilies
+           , FlexibleContexts
+           , ViewPatterns
            #-}
-module Language.Haskell.Tools.Refactor.RenameDefinition (renameDefinition, renameDefinition') where
+module Language.Haskell.Tools.Refactor.RenameDefinition (renameDefinition, renameDefinition', DomainRenameDefinition) where
 
 import Name hiding (Name)
 import GHC (Ghc, TyThing(..), lookupName)
 import qualified GHC
 import OccName
 import SrcLoc
+import Outputable
 
 import Control.Reference hiding (element)
+import qualified Control.Reference as Ref
 import Control.Monad.State
 import Control.Monad.Trans.Except
 import Data.Data
@@ -23,13 +30,16 @@ 
 import Debug.Trace
 
-renameDefinition' :: forall n . (NamedThing n, Data n) => RealSrcSpan -> String -> Ann Module (STWithNames n) -> RefactoredModule n
+type DomainRenameDefinition dom = ( Domain dom, HasNameInfo (SemanticInfo' dom SameInfoNameCls), Data (SemanticInfo' dom SameInfoNameCls)
+                                  , HasScopeInfo (SemanticInfo' dom SameInfoNameCls), HasDefiningInfo (SemanticInfo' dom SameInfoNameCls) )
+
+renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
 renameDefinition' sp str mod
-  = case (getNodeContaining sp mod :: Maybe (Ann SimpleName (STWithNames n))) >>= (fmap getName . (^? semantics&nameInfo)) of 
+  = case (getNodeContaining sp mod :: Maybe (Ann SimpleName dom SrcTemplateStage)) >>= (fmap getName . (semanticsName =<<) . (^? semantics)) of 
       Just n -> renameDefinition n str mod
       Nothing -> refactError "No name is selected"
 
-renameDefinition :: forall n . (NamedThing n, Data n) => GHC.Name -> String -> Ann Module (STWithNames n) -> RefactoredModule n
+renameDefinition :: DomainRenameDefinition dom => GHC.Name -> String -> Ann Module dom SrcTemplateStage -> RefactoredModule dom
 renameDefinition toChange newName mod 
     = do nameCls <- classifyName toChange
          (res,defFound) <- runStateT (biplateRef !~ changeName toChange newName $ mod) False
@@ -37,19 +47,20 @@             | not defFound -> refactError "The definition to rename was not found"
             | otherwise -> return res
   where     
-    changeName :: GHC.Name -> String -> Ann SimpleName (STWithNames n) -> StateT Bool (Refactor n) (Ann SimpleName (STWithNames n))
+    changeName :: DomainRenameDefinition dom => GHC.Name -> String -> Ann SimpleName dom SrcTemplateStage -> StateT Bool (Refactor dom) (Ann SimpleName dom SrcTemplateStage)
     changeName toChange str elem 
-      = if | fmap getName (elem ^? semantics&nameInfo) == Just toChange
-               && (elem ^? semantics&isDefined) == Just False
-               && any ((str ==) . occNameString . getOccName) (maybe [] head (elem ^? semantics & scopedLocals))
+      = if | fmap getName (semanticsName (elem ^. semantics)) == Just toChange
+               && semanticsDefining (elem ^. semantics) == False
+               && any @[] ((str ==) . occNameString . getOccName) (semanticsScope (elem ^. semantics) ^? Ref.element 0 & traversal)
              -> lift $ refactError "The definition clashes with an existing one" -- name clash with an external definition
-           | fmap getName (elem ^? semantics&nameInfo) == Just toChange
-             -> do modify (|| fromMaybe False (elem ^? semantics&isDefined)) 
+           | fmap getName (semanticsName (elem ^. semantics)) == Just toChange
+             -> do modify (|| semanticsDefining (elem ^. semantics))
                    return $ element & unqualifiedName .= mkNamePart str $ elem
-           | let namesInScope = fromMaybe [] (elem ^? semantics & scopedLocals)
-                 actualName = maybe toChange getName (elem ^? semantics & nameInfo)
-              in str == occNameString (getOccName actualName) && sameNamespace toChange actualName 
-                   && conflicts toChange actualName namesInScope
+           | let namesInScope = semanticsScope (elem ^. semantics)
+              in case semanticsName (elem ^. semantics) of 
+                   Just (getName -> exprName) -> str == occNameString (getOccName exprName) && sameNamespace toChange exprName
+                                                   && conflicts toChange exprName namesInScope
+                   Nothing -> False -- ambiguous names
              -> lift $ refactError "The definition clashes with an existing one" -- local name clash
            | otherwise -> return elem
 

@@ -1,5 +1,5 @@ name:                haskell-tools-refactor
-version:             0.1.2.0
+version:             0.1.3.0
 synopsis:            Refactoring Tool for Haskell
 description:         Contains a set of refactorings based on the Haskell-Tools framework to easily transform a Haskell program. For the descriptions of the implemented refactorings, see the homepage.
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -37,12 +37,11 @@                      , time                      >=1.5 && <2.0
                      , filepath                  >=1.4 && <2.0
                      , either                    >=4.0 && <5.0
-                     , haskell-tools-ast         >=0.1.2 && <0.2
-                     , haskell-tools-ast-fromghc >=0.1.2 && <0.2
-                     , haskell-tools-ast-gen     >=0.1.2 && <0.2
-                     , haskell-tools-ast-trf     >=0.1.2 && <0.2
-                     , haskell-tools-prettyprint >=0.1.2 && <0.2
-                     , structural-traversal      >=0.1 && <0.2
+                     , haskell-tools-ast         >=0.1.3 && <0.2
+                     , haskell-tools-ast-fromghc >=0.1.3 && <0.2
+                     , haskell-tools-ast-gen     >=0.1.3 && <0.2
+                     , haskell-tools-ast-trf     >=0.1.3 && <0.2
+                     , haskell-tools-prettyprint >=0.1.3 && <0.2
                      , template-haskell          >=2.0 && <3.0
   default-language:    Haskell2010