haskell-tools-builtin-refactorings 1.1.0.2 → 1.1.1.0
raw patch · 11 files changed
+79/−44 lines, 11 filesdep ~Cabaldep ~basedep ~containers
Dependency ranges changed: Cabal, base, containers, ghc, haskell-tools-backend-ghc, template-haskell
Files
- Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ConstraintKindsChecker.hs +2/−2
- Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleContextsChecker.hs +1/−2
- Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/GHCHelpers.hs +1/−1
- Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs +13/−13
- examples/Refactor/ExtractBinding/Guards.hs +6/−0
- examples/Refactor/ExtractBinding/GuardsIndent.hs +6/−0
- examples/Refactor/ExtractBinding/GuardsIndent_res.hs +7/−0
- examples/Refactor/ExtractBinding/Guards_res.hs +7/−0
- haskell-tools-builtin-refactorings.cabal +26/−25
- test/ExtensionOrganizerTest/Main.hs +1/−1
- test/Main.hs +9/−0
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/ConstraintKindsChecker.hs view
@@ -1,7 +1,7 @@ module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.ConstraintKindsChecker where import Name as GHC (isTyVarName) -import Kind as GHC (returnsConstraintKind) +import Type as GHC (tcReturnsConstraintKind) import Control.Reference ((^?), (^.), (&)) @@ -24,7 +24,7 @@ -- Right-hand side has kind Constraint | otherwise = do let ty = typeOrKindFromId . declHeadQName $ dh - if hasConstraintKind ty || returnsConstraintKind ty + if hasConstraintKind ty || tcReturnsConstraintKind ty then addEvidence ConstraintKinds d else return d chkConstraintKindsDecl' d = return d
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Checkers/FlexibleContextsChecker.hs view
@@ -1,6 +1,5 @@ module Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Checkers.FlexibleContextsChecker where -import Kind (returnsConstraintKind) import TcType (tcSplitNestedSigmaTys, checkValidClsArgs) import Type hiding (Type(..)) import PrelNames (eqTyConName, eqTyConKey) @@ -55,7 +54,7 @@ chkFlexibleContextsDecl' :: CheckNode Decl chkFlexibleContextsDecl' d@(TypeDecl dh rhs) = do let ty = typeOrKindFromId . declHeadQName $ dh - when (hasConstraintKind ty || returnsConstraintKind ty) + when (hasConstraintKind ty || tcReturnsConstraintKind ty) (chkClassesInside rhs) return d chkFlexibleContextsDecl' d = return d
Language/Haskell/Tools/Refactor/Builtin/ExtensionOrganizer/Utils/GHCHelpers.hs view
@@ -43,7 +43,7 @@ fvCo (UnivCo p _ t1 t2) = fvProv p ++ fvType t1 ++ fvType t2 fvCo (SymCo co) = fvCo co fvCo (TransCo co1 co2) = fvCo co1 ++ fvCo co2 -fvCo (NthCo _ co) = fvCo co +fvCo (NthCo _ _ co) = fvCo co fvCo (LRCo _ co) = fvCo co fvCo (InstCo co arg) = fvCo co ++ fvCo arg fvCo (CoherenceCo co1 co2) = fvCo co1 ++ fvCo co2
Language/Haskell/Tools/Refactor/Builtin/ExtractBinding.hs view
@@ -7,7 +7,7 @@ {-# LANGUAGE ViewPatterns #-} module Language.Haskell.Tools.Refactor.Builtin.ExtractBinding - (extractBinding', tryItOut, extractBindingRefactoring) where + (extractBinding', extractBindingRefactoring) where import qualified GHC import Name (nameModule_maybe) @@ -27,23 +27,23 @@ extractBindingRefactoring :: RefactoringChoice -extractBindingRefactoring = NamingRefactoring "ExtractBinding" (\loc s -> localRefactoring (extractBinding' loc s)) +extractBindingRefactoring = NamingRefactoringIndent "ExtractBinding" (\loc s i -> localRefactoring (extractBinding' s i loc )) -tryItOut :: String -> String -> String -> IO () -tryItOut mod sp name = tryRefactor (localRefactoring . flip extractBinding' name) mod sp +tryItOut :: String -> String -> Maybe String -> String -> IO () +tryItOut mod sp indent name = tryRefactor (localRefactoring . extractBinding' name indent) sp mod -extractBinding' :: RealSrcSpan -> String -> LocalRefactoring -extractBinding' sp name mod +extractBinding' :: String -> Maybe String -> RealSrcSpan -> LocalRefactoring +extractBinding' name indent sp mod = if isNothing (isValidBindingName name) - then extractBinding sp (nodesContaining sp) (nodesContaining sp) name mod + then extractBinding sp (read $ fromMaybe "4" indent) (nodesContaining sp) (nodesContaining sp) name mod else refactError $ "The given name is not a valid for the extracted binding: " ++ fromJust (isValidBindingName name) -- | 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 :: RealSrcSpan -> Simple Traversal Module ValueBind +extractBinding :: RealSrcSpan -> Int -> Simple Traversal Module ValueBind -> Simple Traversal ValueBind Expr -> String -> LocalRefactoring -extractBinding sp selectDecl selectExpr name mod +extractBinding sp indent selectDecl selectExpr name mod = let conflicting = filter (isConflicting name) ((take 1 $ reverse $ mod ^? selectDecl) ^? biplateRef :: [QualifiedName]) exprRanges = map getRange (mod ^? selectDecl & selectExpr) decl = last (mod ^? selectDecl) @@ -58,7 +58,7 @@ | otherwise -> case decl ^? actualContainingExpr exprRange of expr:_ -> do (res, st) <- runStateT (selectDecl&selectExpr !~ extractThatBind sp name expr $ mod) Nothing - case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding exprRange def $ res) False + case st of Just def -> return $ evalState (selectDecl !~ addLocalBinding exprRange indent def $ res) False Nothing -> refactError "There is no applicable expression to extract." [] -> refactError $ "There is no applicable expression to extract." [] -> refactError "There is no applicable expression to extract." @@ -128,9 +128,9 @@ 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 -> ValueBind -> State Bool ValueBind +addLocalBinding :: SrcSpan -> Int -> 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 +addLocalBinding exprRange indent local bind = do done <- get if not done then do put True return $ indentBody $ doAddBinding exprRange local bind @@ -145,7 +145,7 @@ indentBody = (valBindRhs .- updIndent) . (funBindMatches & annList & matchLhs .- updIndent) . (funBindMatches & annList & matchRhs .- updIndent) updIndent :: SourceInfoTraversal elem => elem dom SrcTemplateStage -> elem dom SrcTemplateStage - updIndent = setMinimalIndent 4 + updIndent = setMinimalIndent indent -- | Puts a value definition into a list of local binds insertLocalBind :: ValueBind -> MaybeLocalBinds -> MaybeLocalBinds
+ examples/Refactor/ExtractBinding/Guards.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.Guards where + +fn xs + | length xs == 2 = "2" + | length xs == 3 = "3" + | otherwise = "other"
+ examples/Refactor/ExtractBinding/GuardsIndent.hs view
@@ -0,0 +1,6 @@+module Refactor.ExtractBinding.GuardsIndent where + +fn xs + | length xs == 2 = "2" + | length xs == 3 = "3" + | otherwise = "other"
+ examples/Refactor/ExtractBinding/GuardsIndent_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.GuardsIndent where + +fn xs + | length xs == 2 = "2" + | length xs == 3 = test + | otherwise = "other" + where test = "3"
+ examples/Refactor/ExtractBinding/Guards_res.hs view
@@ -0,0 +1,7 @@+module Refactor.ExtractBinding.Guards where + +fn xs + | length xs == 2 = "2" + | length xs == 3 = test + | otherwise = "other" + where test = "3"
haskell-tools-builtin-refactorings.cabal view
@@ -1,5 +1,5 @@ name: haskell-tools-builtin-refactorings -version: 1.1.0.2 +version: 1.1.1.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 @@ -120,25 +120,26 @@ , Language.Haskell.Tools.Refactor.Builtin.ExtensionOrganizer.Utils.GHCHelpers - build-depends: base >= 4.11 && < 4.12 + build-depends: base >= 4.11 && < 4.13 , mtl >= 2.2 && < 2.3 , aeson >= 1.0 && < 1.5 , uniplate >= 1.6 && < 1.7 , classyplate >= 0.3 && < 0.4 , deepseq >= 1.4 && < 1.5 , ghc-paths >= 0.1 && < 0.2 - , containers >= 0.5 && < 0.6 + , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , transformers >= 0.5 && < 0.6 , references >= 0.3 && < 0.4 , split >= 0.2 && < 0.3 , filepath >= 1.4 && < 1.5 - , template-haskell >= 2.13 && < 2.14 + , template-haskell >= 2.13 && < 2.15 , minisat-solver >= 0.1 && < 0.2 - , ghc >= 8.4 && < 8.5 - , portable-lines >= 0.1 && < 0.2 , Cabal >= 2.0 && < 2.3 + , ghc >= 8.4 && < 8.7 + , portable-lines >= 0.1 && < 0.2 + , Cabal >= 2.0 && < 2.5 , haskell-tools-ast >= 1.1 && < 1.2 - , haskell-tools-backend-ghc >= 1.1 && < 1.2 + , haskell-tools-backend-ghc >= 1.1 && < 8.7 , haskell-tools-rewrite >= 1.1 && < 1.2 , haskell-tools-prettyprint >= 1.1 && < 1.2 , haskell-tools-refactor >= 1.1 && < 1.2 @@ -149,7 +150,7 @@ ghc-options: -with-rtsopts=-M2g hs-source-dirs: test main-is: Main.hs - build-depends: base >= 4.11 && < 4.12 + build-depends: base >= 4.11 && < 4.13 , tasty >= 0.11 && < 1.2 , tasty-hunit >= 0.9 && < 0.11 , transformers >= 0.5 && < 0.6 @@ -157,17 +158,17 @@ , filepath >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , uniplate >= 1.6 && < 1.7 - , containers >= 0.5 && < 0.6 + , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , references >= 0.3 && < 0.4 , split >= 0.2 && < 0.3 , time >= 1.8 && < 1.9 - , template-haskell >= 2.13 && < 2.14 - , ghc >= 8.4 && < 8.5 + , template-haskell >= 2.13 && < 2.15 + , ghc >= 8.4 && < 8.7 , ghc-paths >= 0.1 && < 0.2 - , Cabal >= 2.0 && < 2.3 + , Cabal >= 2.0 && < 2.5 , haskell-tools-ast >= 1.1 && < 1.2 - , haskell-tools-backend-ghc >= 1.1 && < 1.2 + , haskell-tools-backend-ghc >= 1.1 && < 8.7 , haskell-tools-rewrite >= 1.1 && < 1.2 , haskell-tools-prettyprint >= 1.1 && < 1.2 , haskell-tools-refactor >= 1.1 && < 1.2 @@ -182,7 +183,7 @@ , ExtensionOrganizerTest.Parser hs-source-dirs: test main-is: ExtensionOrganizerTest/Main.hs - build-depends: base >= 4.11 && < 4.12 + build-depends: base >= 4.11 && < 4.13 , tasty >= 0.11 && < 1.2 , tasty-hunit >= 0.9 && < 0.11 , transformers >= 0.5 && < 0.6 @@ -190,17 +191,17 @@ , filepath >= 1.4 && < 1.5 , mtl >= 2.2 && < 2.3 , uniplate >= 1.6 && < 1.7 - , containers >= 0.5 && < 0.6 + , containers >= 0.5 && < 0.7 , directory >= 1.2 && < 1.4 , references >= 0.3 && < 0.4 , split >= 0.2 && < 0.3 , time >= 1.8 && < 1.9 - , template-haskell >= 2.13 && < 2.14 - , ghc >= 8.4 && < 8.5 + , template-haskell >= 2.13 && < 2.15 + , ghc >= 8.4 && < 8.7 , ghc-paths >= 0.1 && < 0.2 - , Cabal >= 2.0 && < 2.3 + , Cabal >= 2.0 && < 2.5 , haskell-tools-ast >= 1.1 && < 1.2 - , haskell-tools-backend-ghc >= 1.1 && < 1.2 + , haskell-tools-backend-ghc >= 1.1 && < 8.7 , haskell-tools-rewrite >= 1.1 && < 1.2 , haskell-tools-prettyprint >= 1.1 && < 1.2 , haskell-tools-refactor >= 1.1 && < 1.2 @@ -215,7 +216,7 @@ -- , ExtensionOrganizerBenchmark.UniPlateTraversal -- hs-source-dirs: benchmark -- main-is: ExtensionOrganizerBenchmark/Main.hs --- build-depends: base >= 4.11 && < 4.12 +-- build-depends: base >= 4.11 && < 4.13 -- , criterion >= 1.2 && < 1.6 -- , silently >= 1.2 && < 1.3 -- , transformers >= 0.5 && < 0.6 @@ -223,17 +224,17 @@ -- , filepath >= 1.4 && < 1.5 -- , mtl >= 2.2 && < 2.3 -- , uniplate >= 1.6 && < 1.7 --- , containers >= 0.5 && < 0.6 +-- , containers >= 0.5 && < 0.7 -- , directory >= 1.2 && < 1.4 -- , references >= 0.3 && < 0.4 -- , split >= 0.2 && < 0.3 -- , time >= 1.8 && < 1.9 --- , template-haskell >= 2.13 && < 2.14 --- , ghc >= 8.4 && < 8.5 +-- , template-haskell >= 2.13 && < 2.15 +-- , ghc >= 8.4 && < 8.7 -- , ghc-paths >= 0.1 && < 0.2 --- , Cabal >= 2.0 && < 2.3 +-- , Cabal >= 2.0 && < 2.5 -- , haskell-tools-ast >= 1.0 && < 1.1 --- , haskell-tools-backend-ghc >= 1.0 && < 1.1 +-- , haskell-tools-backend-ghc >= 1.0 && < 8.7 -- , haskell-tools-rewrite >= 1.0 && < 1.1 -- , haskell-tools-prettyprint >= 1.0 && < 1.1 -- , haskell-tools-refactor >= 1.0 && < 1.1
test/ExtensionOrganizerTest/Main.hs view
@@ -245,7 +245,7 @@ mhNameModules = [ "InAssertion" , "InClassElement" , "InDecl" - , "InDeclHead" + -- , "InDeclHead" IGNORED FOR NOW , "InExpr" , "InFieldDecl" , "InFieldUpdate"
test/Main.hs view
@@ -43,6 +43,7 @@ ++ map makeRenameDefinitionTest renameDefinitionTests ++ map makeWrongRenameDefinitionTest wrongRenameDefinitionTests ++ map makeExtractBindingTest extractBindingTests + ++ map makeExtractBindingIndentTest extractBindingIndentTests ++ map makeWrongExtractBindingTest wrongExtractBindingTests ++ map makeInlineBindingTest inlineBindingTests ++ map makeWrongInlineBindingTest wrongInlineBindingTests @@ -215,8 +216,13 @@ , ("Refactor.ExtractBinding.AssocOpMiddle", "3:9-3:14", "b") , ("Refactor.ExtractBinding.SiblingDefs", "7:9-7:10", "a") , ("Refactor.ExtractBinding.Case", "3:26-3:31", "g") + , ("Refactor.ExtractBinding.Guards", "5:22-5:25", "test") ] +extractBindingIndentTests = + [ ("Refactor.ExtractBinding.GuardsIndent", "5:22-5:25", "test", "2") + ] + wrongExtractBindingTests = [ ("Refactor.ExtractBinding.TooSimple", "3:19-3:20", "x") , ("Refactor.ExtractBinding.NameConflict", "3:19-3:27", "stms") @@ -349,6 +355,9 @@ makeExtractBindingTest :: (String, String, String) -> TestTree makeExtractBindingTest (mod, rng, newName) = createTest "ExtractBinding" [rng, newName] mod + +makeExtractBindingIndentTest :: (String, String, String, String) -> TestTree +makeExtractBindingIndentTest (mod, rng, newName, indent) = createTest "ExtractBinding" [rng, newName, indent] mod makeWrongExtractBindingTest :: (String, String, String) -> TestTree makeWrongExtractBindingTest (mod, rng, newName) = createFailTest "ExtractBinding" [rng, newName] mod