haskell-tools-builtin-refactorings 1.0.0.1 → 1.0.0.2

raw patch · 16 files changed

+181/−219 lines, 16 filesdep ~eitherdep ~tastydep ~tasty-hunit

Dependency ranges changed: either, tasty, tasty-hunit

Files

Language/Haskell/Tools/Refactor/Builtin.hs +7/−10
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/DerivingsChecker.hs +11/−11
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleInstancesChecker.hs +7/−8
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMonad.hs +2/−6
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/TraverseAST.hs +5/−5
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/TypeLookup.hs +6/−6
Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs +21/−28
Language/Haskell/Tools/Refactor/Builtin/FloatOut.hs +9/−11
Language/Haskell/Tools/Refactor/Builtin/GenerateExports.hs +6/−9
Language/Haskell/Tools/Refactor/Builtin/GenerateTypeSignature.hs +18/−20
Language/Haskell/Tools/Refactor/Builtin/InlineBinding.hs +32/−43
Language/Haskell/Tools/Refactor/Builtin/OrganizeExtensions.hs +9/−11
Language/Haskell/Tools/Refactor/Builtin/OrganizeImports.hs +26/−26
Language/Haskell/Tools/Refactor/Builtin/RenameDefinition.hs +14/−17
haskell-tools-builtin-refactorings.cabal +7/−7
test/Main.hs +1/−1

Language/Haskell/Tools/Refactor/Builtin.hs view

@@ -2,19 +2,16 @@ module Language.Haskell.Tools.Refactor.Builtin ( builtinRefactorings ) where
 
 import Language.Haskell.Tools.Refactor (RefactoringChoice)
-import Language.Haskell.Tools.Refactor.Builtin.ExtractBinding (ExtractBindingDomain, extractBindingRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.ExtractBinding (extractBindingRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.FloatOut (floatOutRefactoring)
-import Language.Haskell.Tools.Refactor.Builtin.GenerateExports (DomGenerateExports, generateExportsRefactoring)
-import Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature (GenerateSignatureDomain, generateTypeSignatureRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.GenerateExports (generateExportsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature (generateTypeSignatureRefactoring)
 import Language.Haskell.Tools.Refactor.Builtin.InlineBinding (inlineBindingRefactoring)
-import Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions (OrganizeExtensionsDomain, organizeExtensionsRefactoring, projectOrganizeExtensionsRefactoring)
-import Language.Haskell.Tools.Refactor.Builtin.OrganizeImports (OrganizeImportsDomain, organizeImportsRefactoring, projectOrganizeImportsRefactoring)
-import Language.Haskell.Tools.Refactor.Builtin.RenameDefinition (DomainRenameDefinition, renameDefinitionRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.OrganizeExtensions (organizeExtensionsRefactoring, projectOrganizeExtensionsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.OrganizeImports (organizeImportsRefactoring, projectOrganizeImportsRefactoring)
+import Language.Haskell.Tools.Refactor.Builtin.RenameDefinition (renameDefinitionRefactoring)
 
-builtinRefactorings :: ( DomGenerateExports dom, OrganizeImportsDomain dom
-                       , DomainRenameDefinition dom, ExtractBindingDomain dom
-                       , GenerateSignatureDomain dom, OrganizeExtensionsDomain dom
-                       ) => [RefactoringChoice dom]
+builtinRefactorings :: [RefactoringChoice]
 builtinRefactorings
   = [ organizeImportsRefactoring
     , projectOrganizeImportsRefactoring

Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/DerivingsChecker.hs view

@@ -144,7 +144,7 @@ chkDataInstance d = return d
 
 
-separateByKeyword :: DataOrNewtypeKeyword dom -> CheckNode Deriving
+separateByKeyword :: DataOrNewtypeKeyword -> CheckNode Deriving
 separateByKeyword keyw derivs
   | isNewtypeDecl keyw = chkByStrat chkClassForNewtype derivs
   | otherwise          = chkByStrat chkClassForData    derivs
@@ -153,7 +153,7 @@                                _               -> False
 
 
-getStrategy :: Deriving dom -> Maybe (DeriveStrategy dom)
+getStrategy :: Deriving -> Maybe DeriveStrategy
 getStrategy d = d ^. (deriveStrategy & annMaybe)
 
 addExtension :: (MonadState ExtMap m, HasRange node) =>
@@ -167,7 +167,7 @@   | Just sname <- nameFromStock x = addExtension sname x
   | otherwise = return x
 
-chkByStrat :: CheckNode' InstanceHead dom -> CheckNode' Deriving dom
+chkByStrat :: CheckNode InstanceHead -> CheckNode Deriving
 chkByStrat checker d
   | Just strat <- getStrategy d = do
     addOccurence DerivingStrategies d
@@ -175,17 +175,17 @@   | otherwise =
     chkDerivingClause checker d
 
-chkStrat :: DeriveStrategy dom -> CheckNode' InstanceHead dom
+chkStrat :: DeriveStrategy -> CheckNode InstanceHead
 chkStrat (_element -> UStockStrategy)    = addStockExtension
 chkStrat (_element -> UNewtypeStrategy)  = addOccurence GeneralizedNewtypeDeriving
 chkStrat (_element -> UAnyClassStrategy) = addOccurence DeriveAnyClass
 
-chkDerivingClause :: CheckNode' InstanceHead dom -> CheckNode' Deriving dom
+chkDerivingClause :: CheckNode InstanceHead -> CheckNode Deriving
 chkDerivingClause checker d@(DerivingOne   x)  = checker x               >> return d
 chkDerivingClause checker d@(DerivingMulti xs) = (annList !~ checker) xs >> return d
 
 -- checks whether the class is stock, and if it is, returns its name
-nameFromStock :: HasNameInfo dom => InstanceHead dom -> Maybe GHC.Name
+nameFromStock :: InstanceHead -> Maybe GHC.Name
 nameFromStock x
   | InstanceHead name <- skipParens x,
     Just sname <- getSemName name,
@@ -214,7 +214,7 @@          | otherwise             -> return ()
       return x
 
-skipParens :: InstanceHead dom -> InstanceHead dom
+skipParens :: InstanceHead -> InstanceHead
 skipParens (ParenInstanceHead x) = skipParens x
 skipParens x = x
 
@@ -236,18 +236,18 @@     return d
 chkStandaloneDeriving d = return d
 
-decompRule :: InstanceRule dom -> (InstanceHead dom, Type dom)
+decompRule :: InstanceRule -> (InstanceHead, Type)
 decompRule instRule = (cls, ty)
   where ihead = instRule  ^. irHead
         cls   = getClassCon   ihead
         ty    = rightmostType ihead
 
-getClassCon :: InstanceHead dom -> InstanceHead dom
+getClassCon :: InstanceHead -> InstanceHead
 getClassCon (AppInstanceHead f _) = getClassCon f
 getClassCon (ParenInstanceHead x) = getClassCon x
 getClassCon x = x
 
-rightmostType :: InstanceHead dom -> Type dom
+rightmostType :: InstanceHead -> Type
 rightmostType ihead
   | AppInstanceHead _ tyvar <- skipParens ihead = tyvar
 
@@ -262,7 +262,7 @@   This is desirable since the underlying type might be a newtype
   in which case GeneralizedNewtypeDeriving might be necessary.
 -}
-isSynNewType :: HasNameInfo dom => Type dom -> ExtMonad Bool
+isSynNewType :: Type -> ExtMonad Bool
 isSynNewType t = do
   mtycon <- runMaybeT . lookupType $ t
   case mtycon of

Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleInstancesChecker.hs view

@@ -33,7 +33,7 @@ chkFlexibleInstances' d@(InstanceDecl rule _)                = checkedReturn rule d
 chkFlexibleInstances' d = return d
 
-checkedReturn :: ExtDomain dom => InstanceRule dom -> a -> ExtMonad a
+checkedReturn :: InstanceRule -> a -> ExtMonad a
 checkedReturn rule x = chkInstanceRule rule >> return x
 
 -- this check DOES transform the AST for its internal computations
@@ -141,11 +141,10 @@         chkListType (ListType v) = chkSingleTyVar v
         chkListType _            = return False
 
-        chkOnlyApp :: (MonadState ([Name dom],[Name dom]) (m1 m2),
+        chkOnlyApp :: (MonadState ([Name],[Name]) (m1 m2),
                        MonadTrans m1,
-                       MonadState ExtMap m2,
-                       ExtDomain dom) =>
-                       Type dom -> MaybeT (m1 m2) Bool
+                       MonadState ExtMap m2) =>
+                       Type -> MaybeT (m1 m2) Bool
         chkOnlyApp (TypeApp f v@(VarType _)) = do
           isTyVar <- chkSingleTyVar v
           if isTyVar
@@ -168,15 +167,15 @@ 
         tyVarSemNameM x = MaybeT . return . semanticsName $ x ^. simpleName
 
-rmTypeMisc :: Type dom -> ExtMonad (Type dom)
+rmTypeMisc :: CheckNode Type
 rmTypeMisc = rmTParens >=> rmTKinded
 
-rmTKinded :: Type dom -> ExtMonad (Type dom)
+rmTKinded :: CheckNode Type
 rmTKinded kt@(KindedType t _) = addOccurence_ KindSignatures kt >> return t
 rmTKinded x                   = return x
 
 -- removes Parentheses from the AST
 -- the structure is reserved
-rmTParens :: Type dom -> ExtMonad (Type dom)
+rmTParens :: CheckNode Type
 rmTParens (ParenType x) = return x
 rmTParens x             = return x

Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/ExtMonad.hs view

@@ -33,13 +33,9 @@ 
 
 type ExtMonad        = ReaderT [Extension] (StateT ExtMap Ghc)
-type ExtDomain dom   = (HasNameInfo dom)
 
-type CheckNode  elem     = forall dom . CheckNode' elem dom
-type CheckNode' elem dom = ExtDomain dom => elem dom -> ExtMonad (elem dom)
-
-type CheckUNode  uelem     = forall dom . CheckUNode' uelem dom
-type CheckUNode' uelem dom = ExtDomain dom => Ann uelem dom SrcTemplateStage -> ExtMonad (Ann uelem dom SrcTemplateStage)
+type CheckNode elem = elem -> ExtMonad elem
+type CheckUNode uelem = Ann uelem IdDom SrcTemplateStage -> ExtMonad (Ann uelem IdDom SrcTemplateStage)
 
 addOccurence' :: (Ord k, HasRange a) =>
                  k -> a -> SMap.Map k [SrcSpan] -> SMap.Map k [SrcSpan]

Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/TraverseAST.hs view

@@ -422,26 +422,26 @@ 
 type PromotedG t dom = Ann (UPromoted t) dom  SrcTemplateStage
 
-traverseAlt :: CheckUNode uexpr -> CheckNode (AltG uexpr)
+traverseAlt :: CheckUNode uexpr -> CheckNode (AltG uexpr IdDom)
 traverseAlt f = (altPattern !~ traversePattern)
                >=> (altRhs !~ traverseCaseRhs f)
                >=> (altBinds & annJust !~ traverseLocalBinds)
 
-traverseCaseRhs :: CheckUNode uexpr -> CheckNode (CaseRhsG uexpr)
+traverseCaseRhs :: CheckUNode uexpr -> CheckNode (CaseRhsG uexpr IdDom)
 traverseCaseRhs f = (rhsCaseExpr !~ f)
                    >=> (rhsCaseGuards & annList !~ traverseGuardedCaseRhs f)
 
-traverseGuardedCaseRhs :: CheckUNode uexpr -> CheckNode (GuardedCaseRhsG uexpr)
+traverseGuardedCaseRhs :: CheckUNode uexpr -> CheckNode (GuardedCaseRhsG uexpr IdDom)
 traverseGuardedCaseRhs f = (caseGuardStmts & annList !~ traverseRhsGuard)
                           >=> (caseGuardExpr !~ f)
 
-traverseStmt :: CheckUNode uexpr -> CheckNode (StmtG uexpr)
+traverseStmt :: CheckUNode uexpr -> CheckNode (StmtG uexpr IdDom)
 traverseStmt f = (stmtPattern !~ traversePattern)
                 >=> (stmtExpr !~ f)
                 >=> (stmtBinds & annList !~ traverseLocalBind)
                 >=> (cmdStmtBinds & annList !~ traverseStmt f)
 
-traversePromoted :: CheckUNode t -> CheckNode (PromotedG t)
+traversePromoted :: CheckUNode t -> CheckNode (PromotedG t IdDom)
 traversePromoted f = (promotedConName !~ traverseName)
                  >=> (promotedElements & annList !~ f)

Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/TypeLookup.hs view

@@ -3,7 +3,7 @@ module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.TypeLookup where
 
 
-import Language.Haskell.Tools.AST (HasNameInfo'(..), HasNameInfo(..), simpleName)
+import Language.Haskell.Tools.AST (simpleName)
 import Language.Haskell.Tools.Refactor
 import Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.ExtMonad
 
@@ -24,7 +24,7 @@                           Nothing -> return t
                           Just _  -> addOccurence TypeSynonymInstances t
 
-lookupSynDefM :: HasNameInfo dom => Type dom -> MaybeT ExtMonad GHC.TyCon
+lookupSynDefM :: Type -> MaybeT ExtMonad GHC.TyCon
 lookupSynDefM t = do
   tything <- lookupType t
   liftMaybe $ lookupSynDef tything
@@ -51,14 +51,14 @@ 
 -- NOTE: Return false if the type is certainly not a newtype
 --       Returns true if it is a newtype or it could not have been looked up
-isNewtype :: HasNameInfo dom => Type dom -> ExtMonad Bool
+isNewtype :: Type -> ExtMonad Bool
 isNewtype t = do
   tycon <- runMaybeT . lookupType $ t
   return $! maybe True isNewtypeTyCon tycon
 
 
 
-lookupType :: HasNameInfo dom => Type dom -> MaybeT ExtMonad GHC.TyThing
+lookupType :: Type -> MaybeT ExtMonad GHC.TyThing
 lookupType t = do
   name  <- liftMaybe . nameFromType $ t
   sname <- liftMaybe . getSemName   $ name
@@ -67,7 +67,7 @@ 
 -- NOTE: gives just name if the type being scrutinised can be newtype
 --       else it gives nothing
-nameFromType :: Type dom -> Maybe (Name dom)
+nameFromType :: Type -> Maybe Name
 nameFromType (TypeApp f _)    = nameFromType f
 nameFromType (ParenType x)    = nameFromType x
 nameFromType (KindedType t _) = nameFromType t
@@ -78,5 +78,5 @@ isNewtypeTyCon (GHC.ATyCon tycon) = GHC.isNewTyCon tycon
 isNewtypeTyCon _ = False
 
-getSemName :: HasNameInfo dom => Name dom -> Maybe GHC.Name
+getSemName :: Name -> Maybe GHC.Name
 getSemName x = semanticsName (x ^. simpleName)

Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, RankNTypes, ScopedTypeVariables, TypeApplications, TypeFamilies, ViewPatterns #-}
 module Language.Haskell.Tools.Refactor.Builtin.ExtractBinding
-  (extractBinding', ExtractBindingDomain, tryItOut, extractBindingRefactoring) where
+  (extractBinding', tryItOut, extractBindingRefactoring) where
 
 import qualified GHC
 import Name (nameModule_maybe)
@@ -19,17 +19,13 @@ import Language.Haskell.Tools.Refactor
 
 
-extractBindingRefactoring :: (ExtractBindingDomain dom, HasModuleInfo dom) => RefactoringChoice dom
+extractBindingRefactoring :: RefactoringChoice
 extractBindingRefactoring = NamingRefactoring "ExtractBinding" (\loc s -> localRefactoring (extractBinding' loc s))
 
--- | We need name information to identify bindings, and scope information to check which
--- entities must be directly passed as parameters.
-type ExtractBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom )
-
 tryItOut :: String -> String -> String -> IO ()
 tryItOut mod sp name = tryRefactor (localRefactoring . flip extractBinding' name) mod sp
 
-extractBinding' :: ExtractBindingDomain dom => RealSrcSpan -> String -> LocalRefactoring dom
+extractBinding' :: RealSrcSpan -> String -> LocalRefactoring
 extractBinding' sp name mod
   = if isNothing (isValidBindingName name)
       then extractBinding sp (nodesContaining sp) (nodesContaining sp) name mod
@@ -37,12 +33,11 @@ 
 -- | Safely performs the transformation to introduce the local binding and replace the expression with the call.
 -- Checks if the introduction of the name causes a name conflict.
-extractBinding :: forall dom . ExtractBindingDomain dom
-               => RealSrcSpan -> Simple Traversal (Module dom) (ValueBind dom)
-                   -> Simple Traversal (ValueBind dom) (Expr dom)
-                   -> String -> LocalRefactoring dom
+extractBinding :: RealSrcSpan -> Simple Traversal Module ValueBind
+                   -> Simple Traversal ValueBind Expr
+                   -> String -> LocalRefactoring
 extractBinding sp selectDecl selectExpr name mod
-  = let conflicting = filter (isConflicting name) ((take 1 $ reverse $ mod ^? selectDecl) ^? biplateRef :: [QualifiedName dom])
+  = let conflicting = filter (isConflicting name) ((take 1 $ reverse $ mod ^? selectDecl) ^? biplateRef :: [QualifiedName])
         exprRanges = map getRange (mod ^? selectDecl & selectExpr)
         decl = last (mod ^? selectDecl)
         declPats = decl ^? valBindPat &+& funBindMatches & annList & matchLhs
@@ -64,14 +59,13 @@         _ `containsRange` _ = False
 
 -- | Decides if a new name defined to be the given string will conflict with the given AST element
-isConflicting :: ExtractBindingDomain dom => String -> QualifiedName dom -> Bool
+isConflicting :: String -> QualifiedName -> Bool
 isConflicting name used
   = semanticsDefining used
       && (GHC.occNameString . GHC.getOccName <$> semanticsName used) == Just name
 
 -- Replaces the selected expression with a call and generates the called binding.
-extractThatBind :: ExtractBindingDomain dom
-                => RealSrcSpan -> String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+extractThatBind :: RealSrcSpan -> String -> Expr -> Expr -> StateT (Maybe ValueBind) LocalRefactor Expr
 extractThatBind sp name cont e
   = do ret <- get -- being in a state monad to only apply the
        if (isJust ret) then return e
@@ -127,7 +121,7 @@           where ops = [plus_RDR, times_RDR, append_RDR, and_RDR, {- or_RDR, -} compose_RDR] -- somehow or is missing... WHY?
 
 -- | Adds a local binding to the where clause of the enclosing binding
-addLocalBinding :: SrcSpan -> ValueBind dom -> ValueBind dom -> State Bool (ValueBind dom)
+addLocalBinding :: SrcSpan -> ValueBind -> ValueBind -> State Bool ValueBind
 -- this uses the state monad to only add the local binding to the first selected element
 addLocalBinding exprRange local bind
   = do done <- get
@@ -147,13 +141,13 @@     updIndent = setMinimalIndent 4
 
 -- | Puts a value definition into a list of local binds
-insertLocalBind :: ValueBind dom -> MaybeLocalBinds dom -> MaybeLocalBinds dom
+insertLocalBind :: ValueBind -> MaybeLocalBinds -> MaybeLocalBinds
 insertLocalBind toInsert locals
   | isAnnNothing locals = mkLocalBinds [mkLocalValBind toInsert]
   | otherwise = annJust & localBinds .- insertWhere True (mkLocalValBind toInsert) (const True) isNothing $ locals
 
 -- | All expressions that are bound stronger than function application.
-isParenLikeExpr :: Expr dom -> Bool
+isParenLikeExpr :: Expr -> Bool
 isParenLikeExpr (If {}) = True
 isParenLikeExpr (Paren {}) = True
 isParenLikeExpr (List {}) = True
@@ -172,8 +166,7 @@ isParenLikeExpr _ = False
 
 -- | Replaces the expression with the call and stores the binding of the call in its state
-doExtract :: ExtractBindingDomain dom
-          => String -> Expr dom -> Expr dom -> StateT (Maybe (ValueBind dom)) (LocalRefactor dom) (Expr dom)
+doExtract :: String -> Expr -> Expr -> StateT (Maybe ValueBind) LocalRefactor Expr
 doExtract name cont e@(Lambda (AnnList bindings) inner)
   = do let params = getExternalBinds cont e
        put (Just (generateBind name (map mkVarPat params ++ bindings) inner))
@@ -184,16 +177,16 @@        return (generateCall name params)
 
 -- | Gets the values that have to be passed to the extracted definition
-getExternalBinds :: ExtractBindingDomain dom => Expr dom -> Expr dom -> [Name dom]
+getExternalBinds :: Expr -> Expr -> [Name]
 getExternalBinds cont expr = map exprToName $ keepFirsts $ filter isApplicableName (expr ^? uniplateRef)
   where isApplicableName (getExprNameInfo -> Just nm) = inScopeForOriginal nm && notInScopeForExtracted nm
         isApplicableName _ = False
 
-        getExprNameInfo :: ExtractBindingDomain dom => Expr dom -> Maybe GHC.Name
+        getExprNameInfo :: Expr -> Maybe GHC.Name
         getExprNameInfo expr = semanticsName =<< (listToMaybe $ expr ^? (exprName&simpleName &+& exprOperator&operatorName))
 
         -- | Creates the parameter value to pass the name (operators are passed in parentheses)
-        exprToName :: Expr dom -> Name dom
+        exprToName :: Expr -> Name
         exprToName e | Just n <- e ^? exprName                     = n
                      | Just op <- e ^? exprOperator & operatorName = mkParenName op
                      | otherwise                                   = error "exprToName: name not found"
@@ -207,20 +200,20 @@         keepFirsts (e:rest) = e : keepFirsts (filter (/= e) rest)
         keepFirsts [] = []
 
-actualContainingExpr :: SrcSpan -> Simple Traversal (ValueBind dom) (Expr dom)
+actualContainingExpr :: SrcSpan -> Simple Traversal ValueBind Expr
 actualContainingExpr (RealSrcSpan rng) = accessRhs & accessExpr
-  where accessRhs :: Simple Traversal (ValueBind dom) (Rhs dom)
+  where accessRhs :: Simple Traversal ValueBind Rhs
         accessRhs = valBindRhs &+& funBindMatches & annList & filtered (rng `isInside`) & matchRhs
-        accessExpr :: Simple Traversal (Rhs dom) (Expr dom)
+        accessExpr :: Simple Traversal Rhs Expr
         accessExpr = rhsExpr &+& rhsGuards & annList & filtered (rng `isInside`) & guardExpr
 actualContainingExpr _ = error "actualContainingExpr: not a real range"
 
 -- | Generates the expression that calls the local binding
-generateCall :: String -> [Name dom] -> Expr dom
+generateCall :: String -> [Name] -> Expr
 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 -> [Pattern dom] -> Expr dom -> ValueBind dom
+generateBind :: String -> [Pattern] -> Expr -> ValueBind
 generateBind name [] e = mkSimpleBind (mkVarPat $ mkNormalName $ mkSimpleName name) (mkUnguardedRhs e) Nothing
 generateBind name args e = mkFunctionBind [mkMatch (mkMatchLhs (mkNormalName $ mkSimpleName name) args) (mkUnguardedRhs e) Nothing]

Language/Haskell/Tools/Refactor/Builtin/FloatOut.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
 module Language.Haskell.Tools.Refactor.Builtin.FloatOut
-  (floatOut, FloatOutDefinition, floatOutRefactoring) where
+  (floatOut, floatOutRefactoring) where
 
 import Control.Monad.State
 import Control.Reference
@@ -12,12 +12,10 @@ import Name as GHC (Name, NamedThing(..), occNameString)
 import SrcLoc (RealSrcSpan)
 
-floatOutRefactoring :: (FloatOutDefinition dom, HasModuleInfo dom) => RefactoringChoice dom
+floatOutRefactoring :: RefactoringChoice
 floatOutRefactoring = SelectionRefactoring "FloatOut" (localRefactoring . floatOut)
 
-type FloatOutDefinition dom = (HasNameInfo dom, HasScopeInfo dom)
-
-floatOut :: FloatOutDefinition dom => RealSrcSpan -> LocalRefactoring dom
+floatOut :: RealSrcSpan -> LocalRefactoring
 floatOut sp mod
   = do (mod', st) <- runStateT (nodesContaining sp !~ extractAndInsert sp $ mod) NotEncountered
        case st of NotEncountered -> refactError "No definition is selected. The selection range must be inside the definition."
@@ -25,16 +23,16 @@                                     return $ modDecl & annListElems .- (++ map toTopLevel bnds) $ removeEmpties mod'
                   Inserted -> -- already inserted to a local scope
                                return (removeEmpties mod')
-  where toTopLevel :: LocalBind dom -> Decl dom
+  where toTopLevel :: LocalBind -> Decl
         toTopLevel (LocalValBind vb) = mkValueBinding vb
         toTopLevel (LocalTypeSig sg) = mkTypeSigDecl sg
         toTopLevel (LocalFixity fx) = mkFixityDecl fx
 
         removeEmpties = removeEmptyBnds (nodesContaining sp) (nodesContaining sp)
 
-data FloatState dom = NotEncountered | Extracted [LocalBind dom] | Inserted
+data FloatState = NotEncountered | Extracted [LocalBind] | Inserted
 
-extractAndInsert :: FloatOutDefinition dom => RealSrcSpan -> LocalBindList dom -> StateT (FloatState dom) (LocalRefactor dom) (LocalBindList dom)
+extractAndInsert :: RealSrcSpan -> LocalBindList -> StateT FloatState LocalRefactor LocalBindList
 extractAndInsert sp locs
   | hasSharedSig = refactError "Cannot float out a definition, since it has a signature shared with other bindings that stay in the scope."
   | not (null nameConflicts) = refactError $ "Cannot float out a definition, since it would cause a name conflicts in the target scope: "
@@ -57,7 +55,7 @@         nameConflicts = concat $ map fst conflicts
         implicitConflicts = concat $ map snd conflicts
 
-checkConflict :: forall dom . FloatOutDefinition dom => LocalBind dom -> ([String], [String])
+checkConflict :: LocalBind -> ([String], [String])
 checkConflict bnd = (concatMap @[] getConflict bndNames, implicits)
   where bndNames = bnd ^? elementName
         getConflict bndName = filter ((== nameStr) . Just) $ map (occNameString . getOccName) outerScope
@@ -66,8 +64,8 @@         implicits = map (occNameString . getOccName)
                         (concatMap getPossibleImplicits bndNames `intersect` getQNames (bnd ^? biplateRef))
 
-        getQNames :: [QualifiedName dom] -> [GHC.Name]
+        getQNames :: [QualifiedName] -> [GHC.Name]
         getQNames = catMaybes . map semanticsName
 
-        getPossibleImplicits :: QualifiedName dom -> [GHC.Name]
+        getPossibleImplicits :: QualifiedName -> [GHC.Name]
         getPossibleImplicits qn = concat (map (map (^. _1)) $ take 2 $ semanticsScope qn) \\ catMaybes (map semanticsName bndNames)

Language/Haskell/Tools/Refactor/Builtin/GenerateExports.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, TupleSections, TypeFamilies #-}
 module Language.Haskell.Tools.Refactor.Builtin.GenerateExports
-  (generateExports, DomGenerateExports, generateExportsRefactoring) where
+  (generateExports, generateExportsRefactoring) where
 
 import Control.Reference ((^?), (.=), (&))
 import Language.Haskell.Tools.Refactor
@@ -10,31 +10,28 @@ import Control.Applicative ((<|>))
 import Data.Maybe (Maybe(..), catMaybes)
 
-generateExportsRefactoring :: (DomGenerateExports dom, HasModuleInfo dom) => RefactoringChoice dom
+generateExportsRefactoring :: RefactoringChoice
 generateExportsRefactoring = ModuleRefactoring "GenerateExports" (localRefactoring generateExports)
 
--- | We need name information to generate exports
-type DomGenerateExports dom = (Domain dom, HasNameInfo dom)
-
 -- | Creates an export list that imports standalone top-level definitions with all of their contained definitions
-generateExports :: DomGenerateExports dom => LocalRefactoring dom
+generateExports :: LocalRefactoring
 generateExports mod = return (modHead & annJust & 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 :: DomGenerateExports dom => Module dom -> [(GHC.Name, Bool)]
+getTopLevels :: Module -> [(GHC.Name, Bool)]
 getTopLevels mod = catMaybes $ map (\d -> fmap (,exportContainOthers d)
                                                (foldl (<|>) Nothing $ map semanticsName $ d ^? elementName))
                                    (filter (\case TypeSigDecl{} -> False; _ -> True)
                                       $ mod ^? modDecl & annList)
-  where exportContainOthers :: Decl dom -> Bool
+  where exportContainOthers :: Decl -> Bool
         exportContainOthers (DataDecl {}) = True
         exportContainOthers (ClassDecl {}) = True
         exportContainOthers _ = False
 
 -- | Create the export for a give name.
-createExports :: [(GHC.Name, Bool)] -> ExportSpecs dom
+createExports :: [(GHC.Name, Bool)] -> ExportSpecs
 createExports elems = mkExportSpecs $ map (mkExportSpec . createExport) elems
   where createExport (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
         createExport (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)

Language/Haskell/Tools/Refactor/Builtin/GenerateTypeSignature.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
 module Language.Haskell.Tools.Refactor.Builtin.GenerateTypeSignature
-  ( generateTypeSignature, generateTypeSignature', GenerateSignatureDomain, tryItOut
+  ( generateTypeSignature, generateTypeSignature', tryItOut
   , generateTypeSignatureRefactoring) where
 
 import GHC hiding (Module)
@@ -20,25 +20,23 @@ 
 import Language.Haskell.Tools.Refactor as AST
 
-type GenerateSignatureDomain dom = ( HasModuleInfo dom, HasIdInfo dom, HasImportInfo dom, HasScopeInfo dom )
-
-generateTypeSignatureRefactoring :: GenerateSignatureDomain dom => RefactoringChoice dom
+generateTypeSignatureRefactoring :: RefactoringChoice
 generateTypeSignatureRefactoring = SelectionRefactoring "GenerateSignature" (localRefactoring . generateTypeSignature')
 
 tryItOut :: String -> String -> IO ()
 tryItOut = tryRefactor (localRefactoring . generateTypeSignature')
 
-generateTypeSignature' :: GenerateSignatureDomain dom => RealSrcSpan -> LocalRefactoring dom
+generateTypeSignature' :: RealSrcSpan -> LocalRefactoring
 generateTypeSignature' sp = generateTypeSignature (nodesContaining sp) (nodesContaining sp) (getValBindInList sp)
 
 -- | Perform the refactoring on either local or top-level definition
-generateTypeSignature :: GenerateSignatureDomain dom => Simple Traversal (Module dom) (DeclList dom)
+generateTypeSignature :: Simple Traversal Module DeclList
                                 -- ^ Access for a top-level definition if it is the selected definition
-                           -> Simple Traversal (Module dom) (LocalBindList dom)
+                           -> Simple Traversal Module LocalBindList
                                 -- ^ Access for a definition list if it contains the selected definition
-                           -> (forall d . (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom))
+                           -> (forall d . (BindingElem d) => AnnList d -> Maybe ValueBind)
                                 -- ^ Selector for either local or top-level declaration in the definition list
-                           -> LocalRefactoring dom
+                           -> LocalRefactoring
 generateTypeSignature topLevelRef localRef vbAccess mod
   = let typeSigs = universeBi mod
         bindings = universeBi mod
@@ -53,11 +51,11 @@              else refactError "No binding without type signature is found at the selection."
 
 
-hasScopedTypeSignatures :: Module dom -> Bool
+hasScopedTypeSignatures :: Module -> Bool
 hasScopedTypeSignatures mod = "ScopedTypeVariables" `elem` (mod ^? filePragmas & annList & lpPragmas & annList & langExt :: [String])
 
-genTypeSig :: forall dom d . (GenerateSignatureDomain dom, BindingElem d) => Bool -> [(GHC.Var, TypeSignature dom, ValueBind dom)] -> (AnnList d dom -> Maybe (ValueBind dom))
-                -> AnnList d dom -> StateT Bool (LocalRefactor dom) (AnnList d dom)
+genTypeSig :: (BindingElem d) => Bool -> [(GHC.Var, TypeSignature, ValueBind)] -> (AnnList d -> Maybe ValueBind)
+                                   -> AnnList d -> StateT Bool LocalRefactor (AnnList d)
 genTypeSig scopedSigs sigBinds vbAccess ls
   | Just vb <- vbAccess ls
   , not (typeSignatureAlreadyExist ls vb)
@@ -91,13 +89,13 @@         dangerousTVs scopedSigs sigBinds
           = let dangerousDecls = if scopedSigs then filter (\(_,ts,_) -> not $ isForalledTS ts) sigBinds else sigBinds
                 dangerousNames = map (\(_,_,bn) -> bn ^? (valBindPats & biplateRef &+& bindingName)) dangerousDecls
-             in concatMap (concatMap @[] (getExternalTVs . idType .  semanticsId @(QualifiedName dom))) dangerousNames
+             in concatMap (concatMap @[] (getExternalTVs . idType . semanticsId @QualifiedName)) dangerousNames
 
-generateTSFor :: GenerateSignatureDomain dom => GHC.Name -> GHC.Type -> LocalRefactor dom (TypeSignature dom)
+generateTSFor :: GHC.Name -> GHC.Type -> LocalRefactor TypeSignature
 generateTSFor n t = mkTypeSignature (mkUnqualName' n) <$> generateTypeFor (-1) (dropForAlls t)
 
 -- | Generates the source-level type for a GHC internal type
-generateTypeFor :: GenerateSignatureDomain dom => Int -> GHC.Type -> LocalRefactor dom (AST.Type dom)
+generateTypeFor :: Int -> GHC.Type -> LocalRefactor AST.Type
 generateTypeFor prec t
   -- context
   | (break (not . isPredTy) -> (preds, other), rt) <- splitFunTys t
@@ -140,24 +138,24 @@   | (tvs@(_:_), t') <- splitForAllTys t
   = wrapParen (-1) <$> (mkForallType (map (mkTypeVar' . getName) tvs) <$> generateTypeFor 0 t')
   | otherwise = error ("Cannot represent type: " ++ showSDocUnsafe (ppr t))
-  where wrapParen :: Int -> AST.Type dom -> AST.Type dom
+  where wrapParen :: Int -> AST.Type -> AST.Type
         wrapParen prec' node = if prec' < prec then mkParenType node else node
 
         getTCId :: GHC.TyCon -> GHC.Id
         getTCId tc = GHC.mkVanillaGlobal (GHC.tyConName tc) (tyConKind tc)
 
-        generateAssertionFor :: GenerateSignatureDomain dom => GHC.Type -> LocalRefactor dom (Assertion dom)
+        generateAssertionFor :: GHC.Type -> LocalRefactor Assertion
         generateAssertionFor t
           | Just (tc, types) <- splitTyConApp_maybe t
           = mkClassAssert <$> referenceName (idName $ getTCId tc) <*> mapM (generateTypeFor 0) types
           | otherwise = error "generateAssertionFor: type not supported yet."
 
 -- | Check whether the definition already has a type signature
-typeSignatureAlreadyExist :: (GenerateSignatureDomain dom, BindingElem d) => AnnList d dom -> ValueBind dom -> Bool
+typeSignatureAlreadyExist :: (BindingElem d) => AnnList d -> ValueBind -> Bool
 typeSignatureAlreadyExist ls vb =
   getBindingName vb `elem` (map semanticsId $ concatMap (^? elementName) (filter isTypeSig $ ls ^? annList))
 
-getBindingName :: GenerateSignatureDomain dom => ValueBind dom -> GHC.Id
+getBindingName :: ValueBind -> GHC.Id
 getBindingName vb = case nub $ map semanticsId $ vb ^? bindingName of
   [n] -> n
   [] -> error "Trying to generate a signature for a binding with no name"
@@ -172,5 +170,5 @@   | Just (tv, t') <- splitForAllTy_maybe t = delete tv $ getExternalTVs t'
   | otherwise = []
 
-isForalledTS :: TypeSignature dom -> Bool
+isForalledTS :: TypeSignature -> Bool
 isForalledTS ts = not $ null @[] $ ts ^? tsType & typeBounded & annList

Language/Haskell/Tools/Refactor/Builtin/InlineBinding.hs view

@@ -2,7 +2,7 @@ -- | Defines the inline binding refactoring that removes a value binding and replaces all occurences
 -- with an expression equivalent to the body of the binding.
 module Language.Haskell.Tools.Refactor.Builtin.InlineBinding
-  (inlineBinding, InlineBindingDomain, tryItOut, inlineBindingRefactoring) where
+  (inlineBinding, tryItOut, inlineBindingRefactoring) where
 
 import Control.Monad.State
 import Control.Reference
@@ -16,23 +16,22 @@ 
 import Language.Haskell.Tools.Refactor as AST
 
-inlineBindingRefactoring :: InlineBindingDomain dom => RefactoringChoice dom
+inlineBindingRefactoring :: RefactoringChoice
 inlineBindingRefactoring = SelectionRefactoring "InlineBinding" inlineBinding
 
 tryItOut :: String -> String -> IO ()
 tryItOut = tryRefactor inlineBinding
 
-type InlineBindingDomain dom = ( HasNameInfo dom, HasDefiningInfo dom, HasScopeInfo dom, HasModuleInfo dom )
 
-inlineBinding :: forall dom . InlineBindingDomain dom => RealSrcSpan -> Refactoring dom
+inlineBinding :: RealSrcSpan -> Refactoring
 inlineBinding span namedMod@(_,mod) mods
-  = let topLevel :: Simple Traversal (Module dom) (DeclList dom)
+  = let topLevel :: Simple Traversal Module DeclList
         topLevel = nodesContaining span
-        local :: Simple Traversal (Module dom) (LocalBindList dom)
+        local :: Simple Traversal Module LocalBindList
         local = nodesContaining span
-        exprs :: Simple Traversal (Module dom) (Expr dom)
+        exprs :: Simple Traversal Module Expr
         exprs = nodesContaining span
-        elemAccess :: (BindingElem d) => AnnList d dom -> Maybe (ValueBind dom)
+        elemAccess :: (BindingElem d) => AnnList d -> Maybe ValueBind
         elemAccess = getValBindInList span
         removed = catMaybes $ map elemAccess (mod ^? topLevel) ++ map elemAccess (mod ^? local)
      in case reverse removed of
@@ -42,17 +41,13 @@             in if | any (containInlined removedBindingName) mods
                     -> refactError "Cannot inline the definition, it is used in other modules."
                   | _:_ <- mod ^? modHead & annJust & mhExports & annJust & biplateRef
-                                          & filtered (\n -> semanticsName (n :: QualifiedName dom) == Just removedBindingName)
+                                          & filtered (\n -> semanticsName (n :: QualifiedName) == Just removedBindingName)
                     -> refactError "Cannot inline the definition, it is present in the export list."
                   | otherwise -> localRefactoring (inlineBinding' topLevel local exprs removedBinding removedBindingName) namedMod mods
 
 -- | Performs the inline binding on a single module.
-inlineBinding' :: InlineBindingDomain dom
-                    => Simple Traversal (Module dom) (DeclList dom)
-                    -> Simple Traversal (Module dom) (LocalBindList dom)
-                    -> Simple Traversal (Module dom) (Expr dom)
-                    -> ValueBind dom -> GHC.Name
-                    -> LocalRefactoring dom
+inlineBinding' :: Simple Traversal Module DeclList -> Simple Traversal Module LocalBindList 
+                    -> Simple Traversal Module Expr -> ValueBind -> GHC.Name -> LocalRefactoring
 inlineBinding' topLevelRef localRef exprRef removedBinding removedBindingName mod
   = do replacement <- createReplacement removedBinding
        let RealSrcSpan bindingSpan = getRange removedBinding
@@ -63,24 +58,20 @@          else return mod''
 
 -- | True if the given module contains the name of the inlined definition.
-containInlined :: forall dom . InlineBindingDomain dom => GHC.Name -> ModuleDom dom -> Bool
+containInlined :: GHC.Name -> ModuleDom -> Bool
 containInlined name (_,mod)
-  = any (\qn -> semanticsName qn == Just name) $ (mod ^? biplateRef :: [QualifiedName dom])
+  = any (\qn -> semanticsName qn == Just name) $ (mod ^? biplateRef :: [QualifiedName])
 
 -- | Removes the inlined binding and the accompanying type and fixity signatures.
-removeBindingAndSig :: InlineBindingDomain dom
-                         => Simple Traversal (Module dom) (DeclList dom)
-                         -> Simple Traversal (Module dom) (LocalBindList dom)
-                         -> Simple Traversal (Module dom) (Expr dom)
-                         -> GHC.Name
-                         -> LocalRefactoring dom
+removeBindingAndSig :: Simple Traversal Module DeclList -> Simple Traversal Module LocalBindList
+                         -> Simple Traversal Module Expr -> GHC.Name -> LocalRefactoring
 removeBindingAndSig topLevelRef localRef exprRef name
   = (return . removeEmptyBnds (topLevelRef & annList & declValBind &+& localRef & annList & localVal) exprRef)
       <=< (topLevelRef !~ removeBindingAndSig' name)
       <=< (localRef !~ removeBindingAndSig' name)
 
-removeBindingAndSig' :: (SourceInfoTraversal d, InlineBindingDomain dom, BindingElem d)
-                     => GHC.Name -> AnnList d dom -> LocalRefactor dom (AnnList d dom)
+removeBindingAndSig' :: (SourceInfoTraversal d, BindingElem d) 
+                     => GHC.Name -> AnnList d -> LocalRefactor (AnnList d)
 removeBindingAndSig' name ls = do
    bnds <- mapM notThatBindOrSig (ls ^? annList)
    return $ (annList .- removeNameFromSigBind) (filterListIndexed (\i _ -> bnds !! i) ls)
@@ -104,12 +95,10 @@         accessLocalRhs = annJust & localBinds & annList & localVal & accessRhs
 
 -- | Check the extracted bindings right-hand-side for possible recursion
-checkForRecursion :: InlineBindingDomain dom
-                  => GHC.Name -> Rhs dom -> LocalRefactor dom ()
+checkForRecursion :: GHC.Name -> Rhs -> LocalRefactor ()
 checkForRecursion n = void . (biplateRef !| checkNameForRecursion n)
 
-checkNameForRecursion :: InlineBindingDomain dom
-                      => GHC.Name -> AST.Name dom -> LocalRefactor dom ()
+checkNameForRecursion :: GHC.Name -> AST.Name -> LocalRefactor ()
 checkNameForRecursion name n
   | semanticsName (n ^. simpleName) == Just name
   = refactError $ "Cannot inline definitions containing direct recursion. Recursive call at: "
@@ -118,8 +107,8 @@ 
 -- | As a top-down transformation, replaces the occurrences of the binding with generated expressions. This method passes
 -- the captured arguments of the function call to generate simpler results.
-replaceInvocations :: InlineBindingDomain dom
-                   => RealSrcSpan -> GHC.Name -> ([[GHC.Name]] -> [Expr dom] -> Expr dom) -> Expr dom -> StateT Bool (LocalRefactor dom) (Expr dom)
+replaceInvocations :: RealSrcSpan -> GHC.Name -> ([[GHC.Name]] -> [Expr] -> Expr) -> Expr 
+                        -> StateT Bool LocalRefactor Expr
 replaceInvocations bindingRange name replacement expr
   | (Var n, args) <- splitApps expr
   , semanticsName (n ^. simpleName) == Just name
@@ -130,7 +119,7 @@   = descendM (replaceInvocations bindingRange name replacement) expr
 
 -- | Splits an application into function and arguments. Works also for operators.
-splitApps :: Expr dom -> (Expr dom, [Expr dom])
+splitApps :: Expr -> (Expr, [Expr])
 splitApps (App f a) = case splitApps f of (fun, args) -> (fun, args ++ [a])
 splitApps (InfixApp l (NormalOp qn) r) = (mkVar (mkParenName qn), [l,r])
 splitApps (InfixApp l (BacktickOp qn) r) = (mkVar (mkNormalName qn), [l,r])
@@ -138,12 +127,12 @@ splitApps expr = (expr, [])
 
 -- | Rejoins the function and the arguments as an expression.
-joinApps :: Expr dom -> [Expr dom] -> Expr dom
+joinApps :: Expr -> [Expr] -> Expr
 joinApps f [] = f
 joinApps f args = parenIfNeeded (foldl mkApp f args)
 
 -- | Create an expression that is equivalent to calling the given bind.
-createReplacement :: InlineBindingDomain dom => ValueBind dom -> LocalRefactor dom ([[GHC.Name]] -> [Expr dom] -> Expr dom)
+createReplacement :: ValueBind -> LocalRefactor ([[GHC.Name]] -> [Expr] -> Expr)
 createReplacement (SimpleBind (VarPat _) (UnguardedRhs e) locals)
   = return $ \_ args -> joinApps (parenIfNeeded $ wrapLocals locals e) args
 createReplacement (SimpleBind _ _ _)
@@ -165,7 +154,7 @@         getArgNum (InfixLhs _ _ _ (AnnList more)) = length more + 2
 
 -- | Replaces names with expressions according to a mapping.
-replaceExprs :: InlineBindingDomain dom => [(GHC.Name, Expr dom)] -> Expr dom -> Expr dom
+replaceExprs :: [(GHC.Name, Expr)] -> Expr -> Expr
 replaceExprs [] = id
 replaceExprs replaces = (uniplateRef .-) $ \case
     Var n | Just name <- semanticsName (n ^. simpleName)
@@ -174,7 +163,7 @@     e -> e
 
 -- | Matches a pattern list with an expression list and generates bindings. Matches until an argument cannot be matched.
-matchArguments :: InlineBindingDomain dom => [Pattern dom] -> [Expr dom] -> ([(GHC.Name, Expr dom)], [Pattern dom], [Expr dom])
+matchArguments :: [Pattern] -> [Expr] -> ([(GHC.Name, Expr)], [Pattern], [Expr])
 matchArguments (ParenPat p : pats) exprs = matchArguments (p:pats) exprs
 matchArguments (p:pats) (e:exprs)
   | Just replacement <- staticPatternMatch p e
@@ -185,7 +174,7 @@ matchArguments [] exprs = ([], [], exprs)
 
 -- | Matches a pattern with an expression. Generates a mapping of names to expressions.
-staticPatternMatch :: InlineBindingDomain dom => Pattern dom -> Expr dom -> Maybe [(GHC.Name, Expr dom)]
+staticPatternMatch :: Pattern -> Expr -> Maybe [(GHC.Name, Expr)]
 staticPatternMatch (VarPat n) e
   | Just name <- semanticsName $ n ^. simpleName
   = Just [(name, e)]
@@ -201,7 +190,7 @@   = Just $ concat subs
 staticPatternMatch _ _ = Nothing
 
-replaceMatch :: Match dom -> Alt dom
+replaceMatch :: Match -> Alt
 replaceMatch (Match lhs rhs locals) = mkAlt (toPattern lhs) (toAltRhs rhs) (locals ^? annJust)
   where toPattern (MatchLhs _ (AnnList pats)) = mkTuplePat pats
         toPattern (InfixLhs lhs _ rhs (AnnList more)) = mkTuplePat (lhs:rhs:more)
@@ -211,24 +200,24 @@ 
         toAltGuardedRhs (GuardedRhs (AnnList guards) expr) = mkGuardedCaseRhs guards expr
 
-wrapLocals :: MaybeLocalBinds dom -> Expr dom -> Expr dom
+wrapLocals :: MaybeLocalBinds -> Expr -> Expr
 wrapLocals bnds = case bnds ^? annJust & localBinds & annList of
                     [] -> id
                     localBinds -> mkLet localBinds
 
 -- | True for patterns that need to be parenthesized if in a lambda
-compositePat :: Pattern dom -> Bool
+compositePat :: Pattern -> Bool
 compositePat (AppPat {}) = True
 compositePat (InfixAppPat {}) = True
 compositePat (TypeSigPat {}) = True
 compositePat (ViewPat {}) = True
 compositePat _ = False
 
-parenIfNeeded :: Expr dom -> Expr dom
+parenIfNeeded :: Expr -> Expr
 parenIfNeeded e = if compositeExprs e then mkParen e else e
 
 -- | True for expresssions that need to be parenthesized if in application
-compositeExprs :: Expr dom -> Bool
+compositeExprs :: Expr -> Bool
 compositeExprs (App {}) = True
 compositeExprs (InfixApp {}) = True
 compositeExprs (Lambda {}) = True
@@ -238,6 +227,6 @@ compositeExprs (Do {}) = True
 compositeExprs _ = False
 
-createLambda :: [Pattern dom] -> Expr dom -> Expr dom
+createLambda :: [Pattern] -> Expr -> Expr
 createLambda [] = id
 createLambda pats = mkLambda (map (\p -> if compositePat p then mkParenPat p else p) pats)

Language/Haskell/Tools/Refactor/Builtin/OrganizeExtensions.hs view

@@ -26,22 +26,20 @@ 
 --       Pretty easy now. Chcek wheter it is already in the ExtMap.
 
-type OrganizeExtensionsDomain dom = (HasModuleInfo dom, ExtDomain dom)
-
-organizeExtensionsRefactoring :: OrganizeExtensionsDomain dom => RefactoringChoice dom
+organizeExtensionsRefactoring :: RefactoringChoice
 organizeExtensionsRefactoring = ModuleRefactoring "OrganizeExtensions" (localRefactoring organizeExtensions)
 
-projectOrganizeExtensionsRefactoring :: OrganizeExtensionsDomain dom => RefactoringChoice dom
+projectOrganizeExtensionsRefactoring :: RefactoringChoice
 projectOrganizeExtensionsRefactoring = ProjectRefactoring "ProjectOrganizeExtensions" projectOrganizeExtensions
 
-projectOrganizeExtensions :: forall dom . OrganizeExtensionsDomain dom => ProjectRefactoring dom
+projectOrganizeExtensions :: ProjectRefactoring
 projectOrganizeExtensions =
   mapM (\(k, m) -> ContentChanged . (k,) <$> localRefactoringRes id m (organizeExtensions m))
 
 tryOut :: String -> String -> IO ()
 tryOut = tryRefactor (localRefactoring . const organizeExtensions)
 
-organizeExtensions :: ExtDomain dom => LocalRefactoring dom
+organizeExtensions :: LocalRefactoring
 organizeExtensions moduleAST = do
   exts <- liftGhc $ reduceExtensions moduleAST
   let isRedundant e = extName `notElem` foundExts && extName `elem` handledExts
@@ -56,7 +54,7 @@     $ moduleAST
 
 -- | Reduces default extension list (keeps unsupported extensions)
-reduceExtensions :: ExtDomain dom => UnnamedModule dom -> Ghc [Extension]
+reduceExtensions :: UnnamedModule -> Ghc [Extension]
 reduceExtensions = \moduleAST -> do
   let expanded = expandDefaults moduleAST
       (xs, ys) = partition isSupported expanded
@@ -82,20 +80,20 @@ 
 
 -- | Collects extensions induced by the source code (with location info)
-collectExtensions :: ExtDomain dom => UnnamedModule dom -> Ghc ExtMap
+collectExtensions :: UnnamedModule -> Ghc ExtMap
 collectExtensions moduleAST = do
   let expanded = expandDefaults moduleAST
   flip execStateT SMap.empty . flip runReaderT expanded . traverseModule $ moduleAST
 
 -- | Collects default extension list, and expands each extension
-expandDefaults :: UnnamedModule dom -> [Extension]
+expandDefaults :: UnnamedModule -> [Extension]
 expandDefaults = nub . concatMap expandExtension . collectDefaultExtensions
 
 -- | Collects extensions enabled by default
-collectDefaultExtensions :: UnnamedModule dom -> [Extension]
+collectDefaultExtensions :: UnnamedModule -> [Extension]
 collectDefaultExtensions = map toExt . getExtensions
   where
-  getExtensions :: UnnamedModule dom -> [String]
+  getExtensions :: UnnamedModule -> [String]
   getExtensions = flip (^?) (filePragmas & annList & lpPragmas & annList & langExt)
 
 toExt :: String -> Extension

Language/Haskell/Tools/Refactor/Builtin/OrganizeImports.hs view

@@ -1,6 +1,12 @@-{-# LANGUAGE ConstraintKinds, FlexibleContexts, LambdaCase, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies #-}
+{-# LANGUAGE ConstraintKinds
+           , FlexibleContexts
+           , LambdaCase
+           , ScopedTypeVariables
+           , TupleSections
+           , TypeApplications
+           , TypeFamilies #-}
 module Language.Haskell.Tools.Refactor.Builtin.OrganizeImports
-  ( organizeImports, OrganizeImportsDomain, projectOrganizeImports
+  ( organizeImports, projectOrganizeImports
   , organizeImportsRefactoring, projectOrganizeImportsRefactoring
   ) where
 
@@ -31,19 +37,17 @@ 
 import Language.Haskell.Tools.Refactor as AST
 
-organizeImportsRefactoring :: OrganizeImportsDomain dom => RefactoringChoice dom
+organizeImportsRefactoring :: RefactoringChoice
 organizeImportsRefactoring = ModuleRefactoring "OrganizeImports" (localRefactoring organizeImports)
 
-projectOrganizeImportsRefactoring :: OrganizeImportsDomain dom => RefactoringChoice dom
+projectOrganizeImportsRefactoring :: RefactoringChoice
 projectOrganizeImportsRefactoring = ProjectRefactoring "ProjectOrganizeImports" projectOrganizeImports
 
-type OrganizeImportsDomain dom = ( HasNameInfo dom, HasImportInfo dom, HasModuleInfo dom, HasImplicitFieldsInfo dom )
-
-projectOrganizeImports :: forall dom . OrganizeImportsDomain dom => ProjectRefactoring dom
+projectOrganizeImports :: ProjectRefactoring
 projectOrganizeImports mods
   = mapM (\(k, m) -> ContentChanged . (k,) <$> localRefactoringRes id m (organizeImports m)) mods
 
-organizeImports :: forall dom . OrganizeImportsDomain dom => LocalRefactoring dom
+organizeImports :: LocalRefactoring
 organizeImports mod
   = do usedTyThings <- catMaybes <$> mapM lookupName usedNames
        let dfs = semanticsDynFlags mod
@@ -67,8 +71,8 @@         usedNames = map getName $ (catMaybes $ map semanticsName
                         -- obviously we don't want the names in the imports to be considered, but both from
                         -- the declarations (used), both from the module head (re-exported) will count as usage
-                      (universeBi (mod ^. modHead) ++ universeBi (mod ^. modDecl) :: [QualifiedName dom]))
-                        ++ concatMap (map fst . semanticsImplicitFlds) (universeBi (mod ^. modDecl) :: [FieldWildcard dom])
+                      (universeBi (mod ^. modHead) ++ universeBi (mod ^. modDecl) :: [QualifiedName]))
+                        ++ concatMap (map fst . semanticsImplicitFlds) (universeBi (mod ^. modDecl) :: [FieldWildcard])
         -- Prelude is not actually exported, but we don't want to remove it if it is explicitly there
         -- otherwise, we might add new imported elements that cause conflicts.
         exportedModules = "Prelude" : (mod ^? modHead & annJust & mhExports & annJust
@@ -92,19 +96,19 @@         patternSynonymAreUsed tts = any (\case AConLike (PatSynCon _) -> True; _ -> False) tts
 
 -- | Sorts the imports in alphabetical order
-sortImports :: forall dom . ImportDeclList dom -> ImportDeclList dom
+sortImports :: ImportDeclList -> ImportDeclList
 sortImports ls = srcInfo & srcTmpSeparators .= filter (not . null . fst) (concatMap (\(sep,elems) -> sep : map fst elems) reordered)
                    $ annListElems .= concatMap (map snd . snd) reordered
                    $ ls
-  where reordered :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+  where reordered :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl)])]
         reordered = map (_2 .- sortBy (compare `on` (^. _2 & importModule & AST.moduleNameString))) parts
 
         parts = map (_2 .- reverse) $ reverse $ breakApart [] imports
 
         -- break up the list of imports to import groups
-        breakApart :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
-                        -> [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)]
-                        -> [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl dom)])]
+        breakApart :: [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl)])]
+                        -> [(([SourceTemplateTextElem], SrcSpan), ImportDecl)]
+                        -> [(([SourceTemplateTextElem], SrcSpan), [(([SourceTemplateTextElem], SrcSpan), ImportDecl)])]
         breakApart res [] = res
         breakApart res ((sep, e) : rest) | length (filter ('\n' ==) (sep ^? _1 & traversal & sourceTemplateText & traversal)) > 1
                                             || "\n#" `isInfixOf` (sep ^? _1 & traversal & sourceTemplateText & traversal)
@@ -117,16 +121,14 @@         imports = zipWithSeparators ls
 
 -- | Modify an import to only import  names that are used.
-narrowImports :: forall dom . OrganizeImportsDomain dom
-              => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> [ClsInst] -> [FamInst] -> ImportDeclList dom -> LocalRefactor dom (ImportDeclList dom)
+narrowImports :: Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> [ClsInst] -> [FamInst] -> ImportDeclList -> LocalRefactor ImportDeclList
 narrowImports noNarrowSubspecs exportedModules usedNames exportedNames prelInsts prelFamInsts imps
   = (annListElems & traversal !~ narrowImport noNarrowSubspecs exportedModules usedNames exportedNames)
       =<< filterListIndexedSt (\i _ -> impsNeeded !! i) imps
   where impsNeeded = neededImports exportedModules (usedNames ++ map fst exportedNames) prelInsts prelFamInsts (imps ^. annListElems)
 
 -- | Reduces the number of definitions used from an import
-narrowImport :: OrganizeImportsDomain dom
-             => Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> ImportDecl dom -> LocalRefactor dom (ImportDecl dom)
+narrowImport :: Bool -> [String] -> [GHC.Name] -> [(GHC.Name, Bool)] -> ImportDecl -> LocalRefactor ImportDecl
 narrowImport noNarrowSubspecs exportedModules usedNames exportedNames imp
   | (imp ^. importModule & moduleNameString) `elem` exportedModules
       || maybe False (`elem` exportedModules) (imp ^? importAs & annJust & importRename & moduleNameString)
@@ -179,14 +181,13 @@ getTopDef (AConLike (PatSynCon _)) = error "getTopDef: should not be called with pattern synonyms"
 getTopDef (ATyCon _) = Nothing
 
-createImportSpec :: [(GHC.Name, Bool)] -> ImportSpec dom
+createImportSpec :: [(GHC.Name, Bool)] -> ImportSpec
 createImportSpec elems = mkImportSpecList $ map createIESpec elems
   where createIESpec (n, False) = mkIESpec (mkUnqualName' (GHC.getName n)) Nothing
         createIESpec (n, True)  = mkIESpec (mkUnqualName' (GHC.getName n)) (Just mkSubAll)
 
 -- | Check each import if it is actually needed
-neededImports :: OrganizeImportsDomain dom
-              => [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> [ImportDecl dom] -> [Bool]
+neededImports :: [String] -> [GHC.Name] -> [ClsInst] -> [FamInst] -> [ImportDecl] -> [Bool]
 neededImports exportedModules usedNames prelInsts prelFamInsts imps = neededImports' usedNames [] imps
   where neededImports' _ _ [] = []
         -- keep the import if any definition is needed from it
@@ -204,14 +205,13 @@                 otherFamInstances = map fi_axiom (concatMap semanticsFamInsts kept ++ prelFamInsts)
 
 -- | Narrows the import specification (explicitly imported elements)
-narrowImportSpecs :: forall dom . OrganizeImportsDomain dom
-                  => Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> IESpecList dom -> LocalRefactor dom (IESpecList dom)
+narrowImportSpecs :: Bool -> [GHC.Name] -> [(GHC.Name, Bool)] -> IESpecList -> LocalRefactor IESpecList
 narrowImportSpecs noNarrowSubspecs usedNames exportedNames
   = (if noNarrowSubspecs then return else annList !~ narrowImportSubspecs neededNames exportedNames)
        >=> filterListSt isNeededSpec
   where neededNames = usedNames ++ map fst exportedNames
 
-        isNeededSpec :: IESpec dom -> Bool
+        isNeededSpec :: IESpec -> Bool
         isNeededSpec ie =
           (semanticsName (ie ^. ieName&simpleName)) `elem` map Just neededNames
           -- if the name is not used, but some of its constructors are used, it is needed
@@ -220,7 +220,7 @@             || (case ie ^? ieSubspec&annJust of Just SubAll -> True; _ -> False)
 
 -- | Reduces the number of definitions imported from a sub-specifier.
-narrowImportSubspecs :: OrganizeImportsDomain dom => [GHC.Name] -> [(GHC.Name, Bool)] -> IESpec dom -> LocalRefactor dom (IESpec dom)
+narrowImportSubspecs :: [GHC.Name] -> [(GHC.Name, Bool)] -> IESpec -> LocalRefactor IESpec
 narrowImportSubspecs neededNames exportedNames ss | noNarrowingForThis = return ss
   | otherwise
   = ieSubspec & annJust & essList !~ filterListSt (\n -> (semanticsName (n ^. simpleName)) `elem` map Just neededNames) $ ss

Language/Haskell/Tools/Refactor/Builtin/RenameDefinition.hs view

@@ -1,6 +1,6 @@ {-# LANGUAGE ConstraintKinds, FlexibleContexts, MultiWayIf, ScopedTypeVariables, TupleSections, TypeApplications, TypeFamilies, ViewPatterns #-}
 module Language.Haskell.Tools.Refactor.Builtin.RenameDefinition
-  (renameDefinition, renameDefinition', DomainRenameDefinition, renameDefinitionRefactoring) where
+  (renameDefinition, renameDefinition', renameDefinitionRefactoring) where
 
 import DataCon (dataConFieldLabels, FieldLbl(..), dataConFieldType)
 import qualified GHC
@@ -19,25 +19,22 @@ import Data.Maybe
 import Language.Haskell.Tools.Refactor
 
-renameDefinitionRefactoring :: DomainRenameDefinition dom => RefactoringChoice dom
+renameDefinitionRefactoring :: RefactoringChoice
 renameDefinitionRefactoring = NamingRefactoring "RenameDefinition" renameDefinition'
 
-type DomainRenameDefinition dom = ( HasNameInfo dom, HasScopeInfo dom, HasDefiningInfo dom
-                                  , HasImplicitFieldsInfo dom, HasModuleInfo dom )
-
-renameDefinition' :: forall dom . DomainRenameDefinition dom => RealSrcSpan -> String -> Refactoring dom
+renameDefinition' :: RealSrcSpan -> String -> Refactoring
 renameDefinition' sp str mod mods
-  = case (getNodeContaining sp (snd mod) :: Maybe (QualifiedName dom)) >>= (fmap getName . semanticsName) of
+  = case (getNodeContaining sp (snd mod) :: Maybe QualifiedName) >>= (fmap getName . semanticsName) of
       Just name -> do let sameNames = bindsWithSameName name (snd mod ^? biplateRef)
                       renameDefinition name sameNames str mod mods
-        where bindsWithSameName :: GHC.Name -> [FieldWildcard dom] -> [GHC.Name]
+        where bindsWithSameName :: GHC.Name -> [FieldWildcard] -> [GHC.Name]
               bindsWithSameName name wcs = catMaybes $ map ((lookup name) . semanticsImplicitFlds) wcs
       Nothing -> case getNodeContaining sp (snd mod) of
                    Just modName -> renameModule (any @[] (sp `isInside`) ((snd mod) ^? modImports&annList&importAs))
                                                 (modName ^. moduleNameString) str mod mods
                    Nothing -> refactError "No name is selected"
 
-renameModule :: forall dom . DomainRenameDefinition dom => Bool -> String -> String -> Refactoring dom
+renameModule :: Bool -> String -> String -> Refactoring
 renameModule isAlias from to m mods
     | any (nameConflict to) (map snd $ m:mods) = refactError "Name conflict when renaming module"
     | isJust (validModuleName to) = refactError $ "The given name is not a valid module name: " ++ fromJust (validModuleName to)
@@ -50,25 +47,25 @@           = ModuleCreated to res mod
         alterChange _ _ c = c
 
-        replaceModuleNames :: LocalRefactoring dom
+        replaceModuleNames :: LocalRefactoring
         replaceModuleNames = modNames & filtered (\e -> (e ^. moduleNameString) == from) != mkModuleName to
           where modNames = modHead & annJust & (mhName &+& mhExports & annJust & espExports & annList & exportModuleName)
                              &+& modImports & annList & ( importModule
                                                             &+& importAs & annJust & importRename )
 
-        alterNormalNames :: LocalRefactoring dom
+        alterNormalNames :: LocalRefactoring
         alterNormalNames mod =
-           biplateRef @_ @(QualifiedName dom) & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
+           biplateRef @_ @QualifiedName & filtered (\e -> concat (intersperse "." (e ^? qualifiers&annList&simpleNameStr)) == from)
              !- (\e -> mkQualifiedName (splitOn "." to) (e ^. unqualifiedName&simpleNameStr)) $ mod
 
-        nameConflict :: String -> Module dom -> Bool
+        nameConflict :: String -> Module -> Bool
         nameConflict to mod
           = let modName = mod ^? modHead&annJust&mhName&moduleNameString
                 imports = mod ^? modImports&annList
                 importNames = map (\imp -> fromMaybe (imp ^. importModule) (imp ^? importAs&annJust&importRename) ^. moduleNameString) imports
              in modName == Just to || to `elem` importNames
 
-renameDefinition :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> Refactoring dom
+renameDefinition :: GHC.Name -> [GHC.Name] -> String -> Refactoring
 renameDefinition toChangeOrig toChangeWith newName mod mods
     = do nameCls <- classifyName toChangeOrig
          (changedModules,defFound) <- runStateT (catMaybes <$> mapM (renameInAModule toChangeOrig toChangeWith newName) (mod:mods)) False
@@ -76,7 +73,7 @@             | not defFound -> refactError "The definition to rename was not found. Maybe it is in another package."
             | otherwise -> return $ map ContentChanged changedModules
   where
-    renameInAModule :: DomainRenameDefinition dom => GHC.Name -> [GHC.Name] -> String -> ModuleDom dom -> StateT Bool Refactor (Maybe (ModuleDom dom))
+    renameInAModule :: GHC.Name -> [GHC.Name] -> String -> ModuleDom -> StateT Bool Refactor (Maybe ModuleDom)
     renameInAModule toChangeOrig toChangeWith newName (name, mod)
       = mapStateT (localRefactoringRes (\f (a,s) -> (fmap (\(n,r) -> (n, f r)) a,s)) mod) $
           do origTT <- GHC.lookupName toChangeOrig
@@ -87,8 +84,8 @@              if isChanged then return $ Just (name, res)
                           else return Nothing
 
-    changeName :: DomainRenameDefinition dom => GHC.Name -> Maybe Id -> [GHC.Name] -> String -> QualifiedName dom
-                                                         -> StateT Bool (StateT Bool (LocalRefactor dom)) (QualifiedName dom)
+    changeName :: GHC.Name -> Maybe Id -> [GHC.Name] -> String -> QualifiedName
+                           -> StateT Bool (StateT Bool LocalRefactor) QualifiedName
     changeName toChangeOrig origId toChangeWith str name
       | maybe False (`elem` toChange) actualName
           && semanticsDefining name == False

haskell-tools-builtin-refactorings.cabal view

@@ -1,5 +1,5 @@ name:                haskell-tools-builtin-refactorings
-version:             1.0.0.1
+version:             1.0.0.2
 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
@@ -115,10 +115,10 @@   hs-source-dirs:      test
   main-is:             Main.hs
   build-depends:       base                      >= 4.10  && < 4.11
-                     , tasty                     >= 0.11 && < 0.12
-                     , tasty-hunit               >= 0.9 && < 0.10
+                     , tasty                     >= 0.11 && < 0.13
+                     , tasty-hunit               >= 0.9 && < 0.11
                      , transformers              >= 0.5  && < 0.6
-                     , either                    >= 4.4  && < 4.5
+                     , either                    >= 4.4  && < 5.1
                      , filepath                  >= 1.4  && < 1.5
                      , mtl                       >= 2.2  && < 2.3
                      , uniplate                  >= 1.6  && < 1.7
@@ -150,10 +150,10 @@   hs-source-dirs:      test
   main-is:             ExtensionOrganizerTest/Main.hs
   build-depends:       base                      >= 4.10 && < 4.11
-                     , tasty                     >= 0.11 && < 0.12
-                     , tasty-hunit               >= 0.9 && < 0.10
+                     , tasty                     >= 0.11 && < 0.13
+                     , tasty-hunit               >= 0.9 && < 0.11
                      , transformers              >= 0.5  && < 0.6
-                     , either                    >= 4.4  && < 4.5
+                     , either                    >= 4.4  && < 5.1
                      , filepath                  >= 1.4  && < 1.5
                      , mtl                       >= 2.2  && < 2.3
                      , uniplate                  >= 1.6  && < 1.7

test/Main.hs view

@@ -518,7 +518,7 @@        assertEqual "The transformed result is not what is expected" (Right (standardizeLineEndings expected))
                                                                     (mapRight standardizeLineEndings res)
 
-testRefactor :: (UnnamedModule IdDom -> LocalRefactoring IdDom) -> String -> IO (Either String String)
+testRefactor :: (UnnamedModule -> LocalRefactoring) -> String -> IO (Either String String)
 testRefactor refact moduleName
   = runGhc (Just libdir) $ do
       initGhcFlags