From 881c7eb23e8531881fe1c5296bb72b889d496a6c Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Tue, 25 Oct 2022 08:34:06 -0700 Subject: [PATCH 1/4] prepend decl tests --- tests/Test/Transform.hs | 56 +++++++++++++++++++ tests/examples/transform/AddLocalDecl7.hs | 20 +++++++ .../transform/AddLocalDecl7.hs.expected | 28 ++++++++++ 3 files changed, 104 insertions(+) create mode 100644 tests/examples/transform/AddLocalDecl7.hs create mode 100644 tests/examples/transform/AddLocalDecl7.hs.expected diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index 5e053ead..b5a0fe9b 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -4,6 +4,7 @@ -- Many of the tests match on a specific expected value,the other patterns should trigger a fail {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-# LANGUAGE LambdaCase #-} module Test.Transform where import Language.Haskell.GHC.ExactPrint @@ -292,6 +293,7 @@ transformHighLevelTests libdir = , mkTestModChange libdir addLocaLDecl4 "AddLocalDecl4.hs" , mkTestModChange libdir addLocaLDecl5 "AddLocalDecl5.hs" , mkTestModChange libdir addLocaLDecl6 "AddLocalDecl6.hs" + , mkTestModChange libdir addLocaLDecl7 "AddLocalDecl7.hs" , mkTestModChange libdir rmDecl1 "RmDecl1.hs" , mkTestModChange libdir rmDecl2 "RmDecl2.hs" @@ -439,6 +441,60 @@ addLocaLDecl6 libdir lp = do debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n" return lp' +addLocaLDecl7 :: Changer +addLocaLDecl7 libdir top = do + Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") + let decl' = setEntryDP (L ld decl) (DifferentLine 1 5) + doAddLocal = do + let lp = makeDeltaAst top + ds <- balanceCommentsList =<< hsDecls lp + ds' <- flip mapM ds $ \d -> do + (d',_) <- modifyValD (getLocA d) d $ \_m ds -> do + pure (prependDecl (wrapDecl decl') ds, Nothing) + pure d' + replaceDecls lp ds' + (lp',_,w) <- runTransformT doAddLocal + debugM $ "addLocaLDecl7:" ++ intercalate "\n" w + return lp' + +prependDecl :: LHsDecl GhcPs -> [LHsDecl GhcPs] -> [LHsDecl GhcPs] +prependDecl ldecl = \case + [] -> [setEntryDP ldecl (DifferentLine 1 2)] + ld1:lds -> ldecl':ld1'':lds + where + (ancOp, ld1'') = case ld1 of + (L (SrcSpanAnn (EpAnn _ _ (EpaComments _)) _) _) -> + error "Unexpected unbalanced comments" + (L (SrcSpanAnn (EpAnn d1Anc d1Ann (EpaCommentsBalanced (L (Anchor c1Rss cAnc) c1:restCs) d1AfterCs)) ss) d1) -> + -- NOTE cannot use setEntryDP to simply assign `DL 1 0` here because when there is a prior comment, the + -- DeltaPos on the declaration is absolute instead of relative, and so we must manually update the + -- DeltaPos to be relative (since there is about to be a prior declaration). + let ld1' = L + (SrcSpanAnn + (EpAnn + (setAnchorDp d1Anc $ DifferentLine 1 0) + d1Ann + (EpaCommentsBalanced (L (Anchor c1Rss $ MovedAnchor $ DifferentLine 1 0) c1:restCs) d1AfterCs)) + ss) + d1 + in (cAnc, ld1') + (L (SrcSpanAnn (EpAnn (Anchor d1Rss d1AncOp) d1Ann epaCs@(EpaCommentsBalanced [] _)) ss) d1) -> + let ld1' = L (SrcSpanAnn (EpAnn (Anchor d1Rss $ MovedAnchor $ DifferentLine 1 0) d1Ann epaCs) ss) d1 + in (d1AncOp, ld1') + L (SrcSpanAnn EpAnnNotUsed _) _ -> error "Unexpected EpAnnNotUsed" + ldecl' = setEntryDP ldecl (getAnchorOpDp ancOp) + +getAnchorDp :: Anchor -> DeltaPos +getAnchorDp (Anchor _ (MovedAnchor dp)) = dp +getAnchorDp (Anchor _ UnchangedAnchor) = error "Unexpected UnchangedAnchor" + +setAnchorDp :: Anchor -> DeltaPos -> Anchor +setAnchorDp (Anchor rss _) dp = Anchor rss (MovedAnchor dp) + +getAnchorOpDp :: AnchorOperation -> DeltaPos +getAnchorOpDp (MovedAnchor dp) = dp +getAnchorOpDp UnchangedAnchor = error "Unexpected UnchangedAnchor" + -- --------------------------------------------------------------------- rmDecl1 :: Changer diff --git a/tests/examples/transform/AddLocalDecl7.hs b/tests/examples/transform/AddLocalDecl7.hs new file mode 100644 index 00000000..768a092e --- /dev/null +++ b/tests/examples/transform/AddLocalDecl7.hs @@ -0,0 +1,20 @@ +module AddLocalDecl7 where + +d1 = 1 + where -- c1 + w1 = 1 + +d2 = 1 + where w2 = 1 + +d3 = 1 + where + +d4 = 1 + +d5 = 1 + where -- c5 + +d6 = 1 where + +d7 = 1 where -- c7 diff --git a/tests/examples/transform/AddLocalDecl7.hs.expected b/tests/examples/transform/AddLocalDecl7.hs.expected new file mode 100644 index 00000000..022a4c56 --- /dev/null +++ b/tests/examples/transform/AddLocalDecl7.hs.expected @@ -0,0 +1,28 @@ +module AddLocalDecl7 where + +d1 = 1 + where nn = 2 + -- c1 + w1 = 1 + +d2 = 1 + where nn = 2 + w2 = 1 + +d3 = 1 + where + nn = 2 + +d4 = 1 + where + nn = 2 + +d5 = 1 + where + nn = 2 -- c5 + +d6 = 1 where + nn = 2 + +d7 = 1 where + nn = 2 -- c7 From d5534b353c125868812dab5f7e795b83a818c4de Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Tue, 25 Oct 2022 10:42:26 -0700 Subject: [PATCH 2/4] wip --- tests/Test/Transform.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index b5a0fe9b..23df2f47 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -466,7 +466,7 @@ prependDecl ldecl = \case (L (SrcSpanAnn (EpAnn _ _ (EpaComments _)) _) _) -> error "Unexpected unbalanced comments" (L (SrcSpanAnn (EpAnn d1Anc d1Ann (EpaCommentsBalanced (L (Anchor c1Rss cAnc) c1:restCs) d1AfterCs)) ss) d1) -> - -- NOTE cannot use setEntryDP to simply assign `DL 1 0` here because when there is a prior comment, the + -- NOTE cannot use setEntryDP to simply assign `DL 1 0` here because when there is no prior decl, the -- DeltaPos on the declaration is absolute instead of relative, and so we must manually update the -- DeltaPos to be relative (since there is about to be a prior declaration). let ld1' = L From 98f3fb395ffa3f1aafe9c4c62b06f835a8ce90d9 Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Wed, 26 Oct 2022 21:12:33 -0700 Subject: [PATCH 3/4] wip --- tests/Test/Transform.hs | 26 ++++++++++++++++- tests/examples/transform/AddLocalDecl8.hs | 20 +++++++++++++ .../transform/AddLocalDecl8.hs.expected | 28 +++++++++++++++++++ 3 files changed, 73 insertions(+), 1 deletion(-) create mode 100644 tests/examples/transform/AddLocalDecl8.hs create mode 100644 tests/examples/transform/AddLocalDecl8.hs.expected diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index 23df2f47..5fd7cdc7 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -31,7 +31,9 @@ import Test.HUnit transformTestsTT :: LibDir -> Test transformTestsTT libdir = TestLabel "transformTestsTT" $ TestList [ - mkTestModChange libdir addLocaLDecl5 "AddLocalDecl5.hs" + mkTestModChange libdir addLocaLDecl5 "AddLocalDecl5.hs", + mkTestModChange libdir addLocaLDecl7 "AddLocalDecl7.hs", + mkTestModChange libdir addLocaLDecl8 "AddLocalDecl8.hs" ] transformTests :: LibDir -> Test @@ -294,6 +296,7 @@ transformHighLevelTests libdir = , mkTestModChange libdir addLocaLDecl5 "AddLocalDecl5.hs" , mkTestModChange libdir addLocaLDecl6 "AddLocalDecl6.hs" , mkTestModChange libdir addLocaLDecl7 "AddLocalDecl7.hs" + , mkTestModChange libdir addLocaLDecl8 "AddLocalDecl8.hs" , mkTestModChange libdir rmDecl1 "RmDecl1.hs" , mkTestModChange libdir rmDecl2 "RmDecl2.hs" @@ -484,6 +487,27 @@ prependDecl ldecl = \case L (SrcSpanAnn EpAnnNotUsed _) _ -> error "Unexpected EpAnnNotUsed" ldecl' = setEntryDP ldecl (getAnchorOpDp ancOp) +addLocaLDecl8 :: Changer +addLocaLDecl8 libdir top = do + Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") + let decl' = setEntryDP (L ld decl) (DifferentLine 1 5) + doAddLocal = do + let lp = makeDeltaAst top + ds <- balanceCommentsList =<< hsDecls lp + ds' <- flip mapM ds $ \d -> do + (d',_) <- modifyValD (getLocA d) d $ \_m ds -> do + pure (appendDecl ds (wrapDecl decl'), Nothing) + pure d' + replaceDecls lp ds' + (lp',_,w) <- runTransformT doAddLocal + debugM $ "addLocaLDecl7:" ++ intercalate "\n" w + return lp' + +appendDecl :: [LHsDecl GhcPs] -> LHsDecl GhcPs -> [LHsDecl GhcPs] +appendDecl old newDecl = case old of + [] -> [setEntryDP newDecl (DifferentLine 1 2)] + old' -> old' <> [setEntryDP newDecl (DifferentLine 1 0)] + getAnchorDp :: Anchor -> DeltaPos getAnchorDp (Anchor _ (MovedAnchor dp)) = dp getAnchorDp (Anchor _ UnchangedAnchor) = error "Unexpected UnchangedAnchor" diff --git a/tests/examples/transform/AddLocalDecl8.hs b/tests/examples/transform/AddLocalDecl8.hs new file mode 100644 index 00000000..f9b07a72 --- /dev/null +++ b/tests/examples/transform/AddLocalDecl8.hs @@ -0,0 +1,20 @@ +module AddLocalDecl8 where + +d1 = 1 + where -- c1 + w1 = 1 + +d2 = 1 + where w2 = 1 + +d3 = 1 + where + +d4 = 1 + +d5 = 1 + where -- c5 + +d6 = 1 where + +d7 = 1 where -- c7 diff --git a/tests/examples/transform/AddLocalDecl8.hs.expected b/tests/examples/transform/AddLocalDecl8.hs.expected new file mode 100644 index 00000000..9e4d31d3 --- /dev/null +++ b/tests/examples/transform/AddLocalDecl8.hs.expected @@ -0,0 +1,28 @@ +module AddLocalDecl8 where + +d1 = 1 + where -- c1 + w1 = 1 + nn = 2 + +d2 = 1 + where w2 = 1 + nn = 2 + +d3 = 1 + where + nn = 2 + +d4 = 1 + where + nn = 2 + +d5 = 1 + where + nn = 2 -- c5 + +d6 = 1 where + nn = 2 + +d7 = 1 where + nn = 2 -- c7 From e326121f17d4e20e38af3ad82baf6051720a0579 Mon Sep 17 00:00:00 2001 From: Santiago Weight Date: Wed, 26 Oct 2022 21:18:47 -0700 Subject: [PATCH 4/4] wip --- tests/Test/Transform.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/tests/Test/Transform.hs b/tests/Test/Transform.hs index 5fd7cdc7..591dfc99 100644 --- a/tests/Test/Transform.hs +++ b/tests/Test/Transform.hs @@ -485,7 +485,7 @@ prependDecl ldecl = \case let ld1' = L (SrcSpanAnn (EpAnn (Anchor d1Rss $ MovedAnchor $ DifferentLine 1 0) d1Ann epaCs) ss) d1 in (d1AncOp, ld1') L (SrcSpanAnn EpAnnNotUsed _) _ -> error "Unexpected EpAnnNotUsed" - ldecl' = setEntryDP ldecl (getAnchorOpDp ancOp) + ldecl' = setEntryDP ldecl (maybe (error "what to do with UnchangedAnchor?") id $ getAnchorOpDp ancOp) addLocaLDecl8 :: Changer addLocaLDecl8 libdir top = do @@ -508,16 +508,12 @@ appendDecl old newDecl = case old of [] -> [setEntryDP newDecl (DifferentLine 1 2)] old' -> old' <> [setEntryDP newDecl (DifferentLine 1 0)] -getAnchorDp :: Anchor -> DeltaPos -getAnchorDp (Anchor _ (MovedAnchor dp)) = dp -getAnchorDp (Anchor _ UnchangedAnchor) = error "Unexpected UnchangedAnchor" - setAnchorDp :: Anchor -> DeltaPos -> Anchor setAnchorDp (Anchor rss _) dp = Anchor rss (MovedAnchor dp) -getAnchorOpDp :: AnchorOperation -> DeltaPos -getAnchorOpDp (MovedAnchor dp) = dp -getAnchorOpDp UnchangedAnchor = error "Unexpected UnchangedAnchor" +getAnchorOpDp :: AnchorOperation -> Maybe DeltaPos +getAnchorOpDp (MovedAnchor dp) = Just dp +getAnchorOpDp UnchangedAnchor = Nothing -- ---------------------------------------------------------------------