Skip to content

Commit

Permalink
wip
Browse files Browse the repository at this point in the history
  • Loading branch information
Santiago Weight committed Oct 27, 2022
1 parent d5534b3 commit 86864e8
Show file tree
Hide file tree
Showing 3 changed files with 73 additions and 1 deletion.
26 changes: 25 additions & 1 deletion tests/Test/Transform.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down Expand Up @@ -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"
Expand Down
20 changes: 20 additions & 0 deletions tests/examples/transform/AddLocalDecl8.hs
Original file line number Diff line number Diff line change
@@ -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
28 changes: 28 additions & 0 deletions tests/examples/transform/AddLocalDecl8.hs.expected
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
module AddLocalDecl8 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

0 comments on commit 86864e8

Please sign in to comment.