summaryrefslogtreecommitdiff
path: root/tests/Test/Transform.hs
diff options
context:
space:
mode:
Diffstat (limited to 'tests/Test/Transform.hs')
-rw-r--r--tests/Test/Transform.hs335
1 files changed, 289 insertions, 46 deletions
diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs
index bfe2e27..399e496 100644
--- a/tests/Test/Transform.hs
+++ b/tests/Test/Transform.hs
@@ -18,11 +18,13 @@ import qualified SrcLoc as GHC
import qualified FastString as GHC
import qualified Data.Generics as SYB
+-- import qualified GHC.SYB.Utils as SYB
import Control.Monad
import System.FilePath
import System.IO
import qualified Data.Map as Map
+-- import Data.List
import Data.Maybe
import System.IO.Silently
@@ -46,6 +48,7 @@ transformLowLevelTests = [
, mkTestModChange changeLayoutLet3 "LayoutLet3.hs" "LayoutLet3"
, mkTestModChange changeLayoutLet3 "LayoutLet4.hs" "LayoutLet4"
, mkTestModChange changeRename1 "Rename1.hs" "Main"
+ , mkTestModChange changeRename2 "Rename2.hs" "Main"
, mkTestModChange changeLayoutIn1 "LayoutIn1.hs" "LayoutIn1"
, mkTestModChange changeLayoutIn3 "LayoutIn3.hs" "LayoutIn3"
, mkTestModChange changeLayoutIn3 "LayoutIn3a.hs" "LayoutIn3a"
@@ -115,7 +118,7 @@ changeLocalDecls2 ans (GHC.L l p) = do
{ annEntryDelta = DP (1,0) }
modifyAnnsT addWhere
let decls = [s,d]
- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
+ -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
modifyAnnsT (captureOrderAnnKey newAnnKey decls)
return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs
(GHC.HsValBinds
@@ -149,11 +152,9 @@ changeLocalDecls ans (GHC.L l p) = do
let a2 = setPrecedingLines s1 2 0 a1
return a2
putAnnsT a'
- let wrapDecl (GHC.L l' w) = GHC.L l' (GHC.ValD w)
- wrapSig (GHC.L l' w) = GHC.L l' (GHC.SigD w)
let oldDecls = GHC.sortLocated $ map wrapDecl (GHC.bagToList binds) ++ map wrapSig sigs
let decls = s:d:oldDecls
- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
+ -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
modifyAnnsT (captureOrder m decls)
return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs
(GHC.HsValBinds
@@ -323,6 +324,9 @@ changeLayoutIn1 ans parsed = return (ans,rename "square" [((7,17),(7,19)),((7,24
changeRename1 :: Changer
changeRename1 ans parsed = return (ans,rename "bar2" [((3,1),(3,4))] parsed)
+changeRename2 :: Changer
+changeRename2 ans parsed = return (ans,rename "joe" [((2,1),(2,5))] parsed)
+
changeLayoutLet3 :: Changer
changeLayoutLet3 ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
@@ -448,7 +452,7 @@ manipulateAstTest' mchange useTH file' modname = do
Just (change,_) -> change ann parsed
let
- printed = exactPrintWithAnns parsed' ann' -- `debug` ("ann=" ++ (show $ map (\(s,a) -> (ss2span s, a)) $ Map.toList ann))
+ printed = exactPrint parsed' ann' -- `debug` ("ann=" ++ (show $ map (\(s,a) -> (ss2span s, a)) $ Map.toList ann))
outcome = if printed == contents
then "Match\n"
else "Fail\n"
@@ -552,97 +556,173 @@ transformHighLevelTests =
mkTestModChange addLocaLDecl1 "AddLocalDecl1.hs" "AddLocalDecl1"
, mkTestModChange addLocaLDecl2 "AddLocalDecl2.hs" "AddLocalDecl2"
, mkTestModChange addLocaLDecl3 "AddLocalDecl3.hs" "AddLocalDecl3"
+ , mkTestModChange addLocaLDecl4 "AddLocalDecl4.hs" "AddLocalDecl4"
+ , mkTestModChange addLocaLDecl5 "AddLocalDecl5.hs" "AddLocalDecl5"
+ , mkTestModChange addLocaLDecl6 "AddLocalDecl6.hs" "AddLocalDecl6"
, mkTestModChange rmDecl1 "RmDecl1.hs" "RmDecl1"
, mkTestModChange rmDecl2 "RmDecl2.hs" "RmDecl2"
, mkTestModChange rmDecl3 "RmDecl3.hs" "RmDecl3"
+ , mkTestModChange rmDecl4 "RmDecl4.hs" "RmDecl4"
+ , mkTestModChange rmDecl5 "RmDecl5.hs" "RmDecl5"
+ , mkTestModChange rmDecl6 "RmDecl6.hs" "RmDecl6"
+ , mkTestModChange rmDecl7 "RmDecl7.hs" "RmDecl7"
, mkTestModChange rmTypeSig1 "RmTypeSig1.hs" "RmTypeSig1"
+ , mkTestModChange rmTypeSig2 "RmTypeSig2.hs" "RmTypeSig2"
+
+ , mkTestModChange addHiding1 "AddHiding1.hs" "AddHiding1"
+ , mkTestModChange addHiding2 "AddHiding2.hs" "AddHiding2"
+
+ , mkTestModChange cloneDecl1 "CloneDecl1.hs" "CloneDecl1"
]
-- ---------------------------------------------------------------------
addLocaLDecl1 :: Changer
addLocaLDecl1 ans lp = do
- Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
- let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
+ Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+ let declAnns' = setPrecedingLines newDecl 1 4 declAnns
+ doAddLocal = do
+ (d1:d2:_) <- hsDecls lp
+ balanceComments d1 d2
+ (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m d -> do
+ return ((newDecl : d),Nothing)
+ replaceDecls lp [d1', d2]
+
+ let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+ -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+addLocaLDecl2 :: Changer
+addLocaLDecl2 ans lp = do
+ Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+ let
doAddLocal = do
tlDecs <- hsDecls lp
let parent = head tlDecs
- decls <- hsDecls parent
balanceComments parent (head $ tail tlDecs)
- modifyAnnsT (setPrecedingLines newDecl 1 4)
+ (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
+ transferEntryDPT (head decls) newDecl
+ setEntryDPT (head decls) (DP (1, 0))
+ return ((newDecl:decls),Nothing)
- parent' <- replaceDecls parent (newDecl:decls)
replaceDecls lp (parent':tail tlDecs)
- let (lp',(ans',_),_w) = runTransform ans doAddLocal
- return (mergeAnnList [declAnns',ans'],lp')
+ let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal
+ -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+ return (ans',lp')
-- ---------------------------------------------------------------------
-addLocaLDecl2 :: Changer
-addLocaLDecl2 ans lp = do
- Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
- let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
-
+addLocaLDecl3 :: Changer
+addLocaLDecl3 ans lp = do
+ Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+ let
doAddLocal = do
+ -- logDataWithAnnsTr "parsed:" lp
+ logDataWithAnnsTr "newDecl:" newDecl
tlDecs <- hsDecls lp
let parent = head tlDecs
- decls <- hsDecls parent
balanceComments parent (head $ tail tlDecs)
- DP (r,c) <- getEntryDPT (head decls)
- modifyAnnsT (setPrecedingLines newDecl r c)
- modifyAnnsT (setPrecedingLines (head decls) 1 0)
+ (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \m decls -> do
+ setPrecedingLinesT newDecl 1 0
+ moveTrailingComments m (last decls)
+ return ((decls++[newDecl]),Nothing)
- parent' <- replaceDecls parent (newDecl:decls)
replaceDecls lp (parent':tail tlDecs)
- let (lp',(ans',_),_w) = runTransform ans doAddLocal
- return (mergeAnnList [declAnns',ans'],lp')
+ let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal
+ -- putStrLn $ "log\n" ++ intercalate "\n" _w
+ return (ans',lp')
-- ---------------------------------------------------------------------
-addLocaLDecl3 :: Changer
-addLocaLDecl3 ans lp = do
- Right (declAnns, newDecl@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
- let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
-
+addLocaLDecl4 :: Changer
+addLocaLDecl4 ans lp = do
+ Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
+ Right (sigAnns, newSig) <- withDynFlags (\df -> parseDecl df "sig" "nn :: Int")
+ -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp
+ let
doAddLocal = do
tlDecs <- hsDecls lp
let parent = head tlDecs
- decls <- hsDecls parent
- balanceComments parent (head $ tail tlDecs)
- modifyAnnsT (setPrecedingLines newDecl 1 0)
+ setPrecedingLinesT newSig 1 0
+ setPrecedingLinesT newDecl 1 0
+
+ (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
+ return ((decls++[newSig,newDecl]),Nothing)
- moveTrailingComments parent (last decls)
- parent' <- replaceDecls parent (decls++[newDecl])
replaceDecls lp (parent':tail tlDecs)
+ let (lp',(ans',_),_w) = runTransform (mergeAnnList [ans,declAnns,sigAnns]) doAddLocal
+ -- putStrLn $ "log\n" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl5 :: Changer
+addLocaLDecl5 ans lp = do
+ let
+ doAddLocal = do
+ [s1,d1,d2,d3] <- hsDecls lp
+
+ transferEntryDPT d2 d3
+
+ (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m _decls -> do
+ return ([d2],Nothing)
+ replaceDecls lp [s1,d1',d3]
+
let (lp',(ans',_),_w) = runTransform ans doAddLocal
- return (mergeAnnList [declAnns',ans'],lp')
+ -- putStrLn $ "log\n" ++ intercalate "\n" _w
+ return (ans',lp')
-- ---------------------------------------------------------------------
+addLocaLDecl6 :: Changer
+addLocaLDecl6 ans lp = do
+ Right (declAnns, newDecl) <- withDynFlags (\df -> parseDecl df "decl" "x = 3")
+ let declAnns' = setPrecedingLines newDecl 1 4 declAnns
+ doAddLocal = do
+ [d1,d2] <- hsDecls lp
+ balanceComments d1 d2
+
+ let GHC.L _ (GHC.ValD (GHC.FunBind _ _ (GHC.MG [m1,m2] _ _ _) _ _ _)) = d1
+ balanceComments m1 m2
+
+ (d1',_) <- modifyValD (GHC.getLoc m1) d1 $ \_m decls -> do
+ return ((newDecl : decls),Nothing)
+ replaceDecls lp [d1', d2]
+
+ let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns') doAddLocal
+ -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+ return (ans',lp')
+-- ---------------------------------------------------------------------
+
rmDecl1 :: Changer
rmDecl1 ans lp = do
let doRmDecl = do
tlDecs <- hsDecls lp
let (d1:s1:d2:ds) = tlDecs
- -- First delete the decl only
+ -- First delete the decl (d2) only
+ balanceComments s1 d2 -- ++AZ++
balanceComments d2 (head ds)
lp1 <- replaceDecls lp (d1:s1:ds)
+ -- return lp1
-- Then delete the sig separately
tlDecs1 <- hsDecls lp1
let (d1':s1':ds') = tlDecs1
+ -- transferEntryDPT s1' (head ds') -- required in HaRe.
balanceComments d1' s1'
balanceComments s1' (head ds')
+ transferEntryDPT s1' (head ds') -- required in HaRe.
replaceDecls lp (d1':ds')
let (lp',(ans',_),_w) = runTransform ans doRmDecl
@@ -655,35 +735,118 @@ rmDecl2 ans lp = do
let
doRmDecl = do
let
+ go :: GHC.LHsExpr GHC.RdrName -> Transform (GHC.LHsExpr GHC.RdrName)
+ go e@(GHC.L _ (GHC.HsLet{})) = do
+ decs <- hsDecls e
+ e' <- replaceDecls e (init decs)
+ return e'
+ go x = return x
+
+ SYB.everywhereM (SYB.mkM go) lp
+
+ let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl3 :: Changer
+rmDecl3 ans lp = do
+ let
+ doRmDecl = do
+ [d1,d2] <- hsDecls lp
+
+ (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1] -> do
+ setPrecedingLinesDeclT sd1 2 0
+ return ([],Just sd1)
+
+ replaceDecls lp [d1',sd1,d2]
+
+ let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:\n" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl4 :: Changer
+rmDecl4 ans lp = do
+ let
+ doRmDecl = do
+ [d1] <- hsDecls lp
+
+ (d1',Just sd1) <- modifyValD (GHC.getLoc d1) d1 $ \_m [sd1,sd2] -> do
+ -- [sd1,sd2] <- hsDecls d1
+ transferEntryDPT sd1 sd2
+
+ setPrecedingLinesDeclT sd1 2 0
+ -- d1' <- replaceDecls d1 [sd2]
+ return ([sd2],Just sd1)
+
+ replaceDecls lp [d1',sd1]
+
+ let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl5 :: Changer
+rmDecl5 ans lp = do
+ let
+ doRmDecl = do
+ let
go :: GHC.HsExpr GHC.RdrName -> Transform (GHC.HsExpr GHC.RdrName)
go (GHC.HsLet lb expr) = do
- decs <- hsDecls lb
- lb' <- replaceDecls lb (init decs)
+ decs <- hsDeclsValBinds lb
+ let dec = last decs
+ transferEntryDPT (head decs) dec
+ lb' <- replaceDeclsValbinds lb [dec]
return (GHC.HsLet lb' expr)
go x = return x
SYB.everywhereM (SYB.mkM go) lp
let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:" ++ intercalate "\n" _w
return (ans',lp')
-- ---------------------------------------------------------------------
-rmDecl3 :: Changer
-rmDecl3 ans lp = do
+rmDecl6 :: Changer
+rmDecl6 ans lp = do
+ let
+ doRmDecl = do
+ [d1] <- hsDecls lp
+
+ (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m subDecs -> do
+ let (ss1:_sd1:sd2:sds) = subDecs
+ transferEntryDPT ss1 sd2
+
+ return (sd2:sds,Nothing)
+
+ replaceDecls lp [d1']
+
+ let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl7 :: Changer
+rmDecl7 ans lp = do
let
doRmDecl = do
tlDecs <- hsDecls lp
- let [d1] = tlDecs
+ let [s1,d1,d2,d3] = tlDecs
- subDecs <- hsDecls d1
- let [sd1] = subDecs
+ balanceComments d1 d2
+ balanceComments d2 d3
- modifyAnnsT (setPrecedingLinesDecl sd1 2 0)
- d1' <- replaceDecls d1 []
- replaceDecls lp [d1',sd1]
+ transferEntryDPT d2 d3
+
+ replaceDecls lp [s1,d1,d3]
let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:" ++ intercalate "\n" _w
return (ans',lp')
-- ---------------------------------------------------------------------
@@ -701,3 +864,83 @@ rmTypeSig1 ans lp = do
return (ans',lp')
-- ---------------------------------------------------------------------
+
+rmTypeSig2 :: Changer
+rmTypeSig2 ans lp = do
+ let doRmDecl = do
+ tlDecs <- hsDecls lp
+ let [d1] = tlDecs
+
+ (d1',_) <- modifyValD (GHC.getLoc d1) d1 $ \_m [s,d] -> do
+ transferEntryDPT s d
+ return ([d],Nothing)
+ replaceDecls lp [d1']
+
+ let (lp',(ans',_),_w) = runTransform ans doRmDecl
+ -- putStrLn $ "log:" ++ intercalate "\n" _w
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding1 :: Changer
+addHiding1 ans (GHC.L l p) = do
+ let doTransform = do
+ l0 <- uniqueSrcSpanT
+ l1 <- uniqueSrcSpanT
+ l2 <- uniqueSrcSpanT
+ let
+ [GHC.L li imp1,imp2] = GHC.hsmodImports p
+ n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))
+ n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))
+ v1 = GHC.L l1 (GHC.IEVar n1)
+ v2 = GHC.L l2 (GHC.IEVar n2)
+ impHiding = GHC.L l0 [v1,v2]
+ imp1' = imp1 { GHC.ideclHiding = Just (True,impHiding)}
+ p' = p { GHC.hsmodImports = [GHC.L li imp1',imp2]}
+ addSimpleAnnT impHiding (DP (0,1)) [((G GHC.AnnHiding),DP (0,0)),((G GHC.AnnOpenP),DP (0,1)),((G GHC.AnnCloseP),DP (0,0))]
+ addSimpleAnnT n1 (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]
+ addSimpleAnnT n2 (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
+ return (GHC.L l p')
+
+ let (lp',(ans',_),_w) = runTransform ans doTransform
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding2 :: Changer
+addHiding2 ans (GHC.L l p) = do
+ let doTransform = do
+ l1 <- uniqueSrcSpanT
+ l2 <- uniqueSrcSpanT
+ let
+ [GHC.L li imp1] = GHC.hsmodImports p
+ Just (_,GHC.L lh ns) = GHC.ideclHiding imp1
+ (GHC.L _ (GHC.IEVar ln)) = last ns
+ n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))
+ n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))
+ v1 = GHC.L l1 (GHC.IEVar n1)
+ v2 = GHC.L l2 (GHC.IEVar n2)
+ imp1' = imp1 { GHC.ideclHiding = Just (True,GHC.L lh (ns ++ [v1,v2]))}
+ p' = p { GHC.hsmodImports = [GHC.L li imp1']}
+ addSimpleAnnT n1 (DP (0,0)) [((G GHC.AnnVal),DP (0,0)),((G GHC.AnnComma),DP (0,0))]
+ addSimpleAnnT n2 (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
+ addTrailingCommaT ln
+ return (GHC.L l p')
+
+ let (lp',(ans',_),_w) = runTransform ans doTransform
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------
+
+cloneDecl1 :: Changer
+cloneDecl1 ans lp = do
+ let doChange = do
+ tlDecs <- hsDecls lp
+ let (d1:d2:ds) = tlDecs
+ d2' <- fst <$> cloneT d2
+ replaceDecls lp (d1:d2:d2':ds)
+
+ let (lp',(ans',_),_w) = runTransform ans doChange
+ return (ans',lp')
+
+-- ---------------------------------------------------------------------