HaRe 0.7.1.5 → 0.7.1.6
raw patch · 7 files changed
+94/−33 lines, 7 files
Files
- ChangeLog +4/−0
- HaRe.cabal +8/−2
- src/Language/Haskell/Refact/Case.hs +1/−1
- src/Language/Haskell/Refact/MoveDef.hs +6/−6
- src/Language/Haskell/Refact/Utils/DualTree.hs +52/−12
- src/Language/Haskell/Refact/Utils/TypeUtils.hs +21/−10
- src/Language/Haskell/Refact/Utils/Utils.hs +2/−2
ChangeLog view
@@ -1,3 +1,7 @@+2014-03-19 v0.7.1.6+ * Do not treat single-line layout as a group, hence preserving+ layout of adjacent let expressions when renaming.+ * Process Template Haskell expressions instead of blowing up 2014-03-17 v0.7.1.5 * Adding parameters to lifted declarations now works as expected 2014-03-09 v0.7.1.4
HaRe.cabal view
@@ -1,5 +1,5 @@ Name: HaRe-Version: 0.7.1.5+Version: 0.7.1.6 Author: Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer: Alan Zimmerman Stability: Alpha@@ -20,7 +20,13 @@ control system before refactoring. The developers make no warranties, use at your own risk. .- The renaming refactoring seems reasonably reliable.+ Despite the disclaimer, HaRe attempts to operate in a safe way, by+ first writing new files with proposed changes, and only swapping+ these with the originals when the change is accepted. In the+ process the original file is renamed to have the current date/time+ as a suffix. Thus it should be possible to (manually) undo changes.+ .+ The renaming refactoring seems reasonably reliable, as does lifting. . Synopsis: the Haskell Refactorer.
src/Language/Haskell/Refact/Case.hs view
@@ -58,7 +58,7 @@ inExp exp1@(GHC.L l (GHC.HsIf _se (GHC.L l1 _) (GHC.L l2 _) (GHC.L l3 _))) | sameOccurrence expr exp1 = do- drawTokenTreeDetailed "reallyDoIfToCase" -- ++AZ++ debug+ -- drawTokenTreeDetailed "reallyDoIfToCase" -- ++AZ++ debug newExp <- ifToCaseTransform exp1 let (GHC.RealSrcLoc rl) = GHC.srcSpanStart l
src/Language/Haskell/Refact/MoveDef.hs view
@@ -315,7 +315,7 @@ moveDecl1 t defName ns mliftedDecls sigNames topLevel = do -- logm $ "moveDecl1:t=" ++ (SYB.showData SYB.Renamer 0 t) -- ++AZ++ logm $ "moveDecl1:mliftedDecls=" ++ (showGhc mliftedDecls)- drawTokenTree "moveDecl1 on entry"+ -- drawTokenTree "moveDecl1 on entry" -- TODO: work with all of ns, not just the first let n = ghead "moveDecl1" ns@@ -357,9 +357,9 @@ logm $ "moveDecl1:maybeToksSig=" ++ (show maybeToksSig) -- ++AZ++ logm $ "moveDecl1:(defName,topLevel)" ++ (showGhc (defName,topLevel)) -- ++AZ++ - drawTokenTree "moveDecl1 about to addDecl"+ -- drawTokenTree "moveDecl1 about to addDecl" r <- addDecl t' defName (ghead "moveDecl1 2" funBinding,sigsRemoved,Just (maybeToksSig ++ funToks)) topLevel- drawTokenTree "moveDecl1 done"+ -- drawTokenTree "moveDecl1 done" return r @@ -822,18 +822,18 @@ then error "This pattern binding cannot be lifted, as it uses some other local bindings!" else do -- first remove the decls to be lifted, so they are not disturbed (parent'',liftedDecls'',_msig) <- rmDecl pn False parent- drawTokenTree "addParamsToParentAndLiftedDecl: rmDecl done"+ -- drawTokenTree "addParamsToParentAndLiftedDecl: rmDecl done" logm $ "addParamsToParentAndLiftedDecl:parent''=" ++ (SYB.showData SYB.Renamer 0 parent'') logm $ "addParamsToParentAndLiftedDecl:parent''=" ++ (showGhc parent'') parent' <- addParamsToParent pn newParams parent'' -- let parent' = parent logm $ "addParamsToParentAndLiftedDecl: parent done"- drawTokenTree "addParamsToParentAndLiftedDecl: parent params done"+ -- drawTokenTree "addParamsToParentAndLiftedDecl: parent params done" liftedDecls' <- addParamsToDecls [liftedDecls''] pn newParams True logm $ "addParamsToParentAndLiftedDecl: liftedDecls done"- drawTokenTree "addParamsToParentAndLiftedDecl: liftedDecls done"+ -- drawTokenTree "addParamsToParentAndLiftedDecl: liftedDecls done" return (parent', liftedDecls',True) else return (parent,liftedDecls,False)
src/Language/Haskell/Refact/Utils/DualTree.hs view
@@ -109,15 +109,12 @@ instance (Action Transformation Up) where- -- act AsIs s = s- -- act (T _n) (Up sspan a s ds) = (Up sspan a s ds) act (TAbove _co _bo _p1 _p2 _eo) (Up sspan _a s ds) = (Up sspan a' s' ds) where a' = AVertical s' = NE.map (\(Line r c o ss _f toks) -> (Line r c o ss OGroup toks)) s+ act (TAbove _co _bo _p1 _p2 _eo) (UDeleted ds) = UDeleted ds- -- act (TDeleted _sspan _ro _p) (Up sspan a s ds) = (Up sspan a s ds)- -- act TAdded s = s -- --------------------------------------------------------------------- @@ -143,15 +140,10 @@ GHC.<+> GHC.ppr pg GHC.<+> GHC.ppr p instance GHC.Outputable Transformation where- -- ppr (AsIs) = GHC.parens $ GHC.text "AsIs"- -- ppr (T n) = GHC.parens $ GHC.text "T" GHC.<+> GHC.text (show n) ppr (TAbove co bo p1 p2 eo) = GHC.parens $ GHC.text "TAbove" GHC.<+> GHC.ppr co GHC.<+> GHC.ppr bo GHC.<+> GHC.ppr p1 GHC.<+> GHC.ppr p2 GHC.<+> GHC.ppr eo- -- ppr (TDeleted sspan ro p) = GHC.parens $ GHC.text "TAbove" GHC.<+> GHC.ppr sspan- -- GHC.<+> GHC.ppr ro GHC.<+> GHC.ppr p- -- ppr (TAdded) = GHC.parens $ GHC.text "TAdded" instance GHC.Outputable EndOffset where ppr None = GHC.text "None"@@ -298,12 +290,22 @@ layoutTreeToSourceTree (T.Node (Entry sspan NoChange []) ts0) = annot (ASubtree sspan) (mconcatl $ map layoutTreeToSourceTree ts0)++-- TODO: only apply TAbove if the subs go on to the next line layoutTreeToSourceTree (T.Node (Entry sspan (Above bo p1 p2 eo) []) ts0)- = annot (ASubtree sspan)- (applyD (TAbove co bo p1 p2 eo) subs)+ = case (numLines ts0) of+ 0 -> annot (ASubtree sspan) (mconcatl $ map layoutTreeToSourceTree ts0)+ _ -> annot (ASubtree sspan)+ (applyD (TAbove co bo p1 p2 eo) subs) where subs = (mconcatl $ map layoutTreeToSourceTree ts0) co = 0+ numLines :: [T.Tree Entry] -> Int+ numLines [] = 0+ numLines sts = l - f+ where+ ((f,_),_ ) = forestSpanToSimpPos $ treeStartEnd $ head sts+ (_ ,(l,_)) = forestSpanToSimpPos $ treeStartEnd $ last sts layoutTreeToSourceTree (T.Node (Entry sspan _lay toks) _ts) = leaf (mkUp sspan toks) (PToks toks) @@ -411,9 +413,47 @@ addOffsetToGroup _off [] = [] addOffsetToGroup _off (ls@((Line _r _c _f _aa ONone _s):_)) = ls- addOffsetToGroup off ((Line r c f aa OGroup s):ls) = (Line r (c+off) f aa OGroup s) : addOffsetToGroup off ls+ addOffsetToGroup off ((Line r c f aa OGroup s):ls)+ = (Line r (c+off) f aa OGroup s) : addOffsetToGroup off ls {-+++Should be 7 7 0 on second line++ (Up+ (Span (5, 7) (7, 19)) ANone+ [(Line 5 7 0 SOriginal OGroup \"let park = 3\"),+ (Line 7 5 0 SOriginal OGroup \"let expr = 2\")]+ []),++combining (where "park" was originally "parsed" i.e. 2 letters shorter++ [((Up+ (Span (5, 7) (5, 21)) ANone+ [(Line 5 7 0 SOriginal OGroup \"let park = 3\")]+ []),++ ((Up+ (Span (7, 7) (7, 19)) ANone+ [(Line 7 7 0 SOriginal OGroup \"let expr = 2\")]+ []),++++++++++++++++-------------------------------------------------------- ((((36,23),(41,25)),ITblockComment \" ++AZ++ : hsBinds does not re
src/Language/Haskell/Refact/Utils/TypeUtils.hs view
@@ -1266,17 +1266,28 @@ expr ((GHC.HsCoreAnn _ e)) = hsFreeAndDeclaredGhc e - expr ((GHC.HsBracket b))+ expr ((GHC.HsBracket (GHC.ExpBr b))) = hsFreeAndDeclaredGhc b+ expr ((GHC.HsBracket (GHC.PatBr b)))+ = hsFreeAndDeclaredGhc b+ expr ((GHC.HsBracket (GHC.DecBrL b)))+ = hsFreeAndDeclaredGhc b+ expr ((GHC.HsBracket (GHC.DecBrG b)))+ = hsFreeAndDeclaredGhc b+ expr ((GHC.HsBracket (GHC.TypBr b)))+ = hsFreeAndDeclaredGhc b+ expr ((GHC.HsBracket (GHC.VarBr _ n)))+ = return (FN [],DN [n]) + expr ((GHC.HsBracketOut b _ps)) = hsFreeAndDeclaredGhc b - expr ((GHC.HsSpliceE e))+ expr ((GHC.HsSpliceE (GHC.HsSplice _ e))) = hsFreeAndDeclaredGhc e - expr ((GHC.HsQuasiQuoteE q))- = hsFreeAndDeclaredGhc q+ expr ((GHC.HsQuasiQuoteE _q))+ = return emptyFD expr ((GHC.HsProc pa cmd)) = do fdp <- hsFreeAndDeclaredGhc pa@@ -4088,7 +4099,7 @@ in toks1' else toks - drawTokenTreeDetailed "before starting"+ -- drawTokenTreeDetailed "before starting" logm $ "addImportDecl:toks =" ++ show toks logm $ "addImportDecl:toks1=" ++ show toks1 @@ -4886,7 +4897,7 @@ setStateStorage StorageNone t2 <- everywhereMStaged' SYB.Renamer (SYB.mkM inLet) t -- top down -- drawTokenTreeDetailed "rmDecl.entry after inLet" -- ++AZ++ 'in' missing- drawTokenTree "rmDecl.entry after inLet" -- ++AZ++ 'in' missing+ -- drawTokenTree "rmDecl.entry after inLet" -- ++AZ++ 'in' missing t' <- everywhereMStaged' SYB.Renamer (SYB.mkM inDecls `SYB.extM` inGRHSs) t2 -- top down -- applyTP (once_tdTP (failTP `adhocTP` inDecls)) t@@ -4943,16 +4954,16 @@ -- drawTokenTreeDetailed "rmDecl.inLet tree" -- ++AZ++ missing -- toks <- getToksForSpanWithIntros l removeToksForPos (getStartEndLoc decl)- drawTokenTree "rmDecl.inLet after removeToksForPos"+ -- drawTokenTree "rmDecl.inLet after removeToksForPos" decl' <- syncDeclToLatestStash decl setStateStorage (StorageBind decl')- drawTokenTree "rmDecl.inLet after syncDeclToLatestStash"+ -- drawTokenTree "rmDecl.inLet after syncDeclToLatestStash" case length decls of 1 -> do -- Removing the last declaration logm $ "rmDecl.inLet:length decls = 1: expr=" ++ (SYB.showData SYB.Renamer 0 expr) -- putToksForSpan ss toks (_,expr') <- putDeclToksForSpan ss expr $ dropWhile (\tok -> isEmpty tok || isIn tok) toks- drawTokenTree "rmDecl.inLet after putToksForSpan"+ -- drawTokenTree "rmDecl.inLet after putToksForSpan" return expr' _ -> do logm $ "rmDecl.inLet:length decls /= 1"@@ -5274,7 +5285,7 @@ | (GHC.nameUnique n == GHC.nameUnique oldPN) = do logm $ "renamePNworker:rename at :" ++ (show l) ++ (showSrcSpanF l)- drawTokenTree "before worker" -- ++AZ++ debug+ -- drawTokenTree "before worker" -- ++AZ++ debug worker useQual l Nothing return (GHC.L l newName) rename x = return x
src/Language/Haskell/Refact/Utils/Utils.hs view
@@ -385,9 +385,9 @@ inExp (e::GHC.Located (GHC.HsExpr n)) | sameOccurrence e oldExp = do- drawTokenTree "update Located HsExpr starting" -- ++AZ+++ -- drawTokenTree "update Located HsExpr starting" -- ++AZ++ _ <- updateToks oldExp newExp prettyprint False- drawTokenTree "update Located HsExpr done" -- ++AZ+++ -- drawTokenTree "update Located HsExpr done" -- ++AZ++ -- error "update: updated tokens" -- ++AZ++ debug -- TODO: make sure to call syncAST