summaryrefslogtreecommitdiff
path: root/tests/Test/Transform.hs
blob: 43369aa47324a66d62e2809323d9b3fb93333d33 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Test.Transform where

import Language.Haskell.GHC.ExactPrint
import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Parsers

import qualified Bag            as GHC
import qualified GHC            as GHC
import qualified OccName        as GHC
import qualified RdrName        as GHC
import qualified SrcLoc         as GHC
import qualified FastString     as GHC

import qualified Data.Generics as SYB
-- import qualified GHC.SYB.Utils as SYB

import System.FilePath
import qualified Data.Map as Map
-- import Data.List
import Data.Maybe

import Test.Common

import Test.HUnit

transformTests :: Test
transformTests = TestLabel "transformation tests" $ TestList
  [
    TestLabel "Low level transformations"
       (TestList transformLowLevelTests)
  , TestLabel "High level transformations"
       (TestList transformHighLevelTests)
  ]

transformLowLevelTests :: [Test]
transformLowLevelTests = [
    mkTestModChange changeRenameCase1 "RenameCase1.hs"
  , mkTestModChange changeLayoutLet2  "LayoutLet2.hs"
  , mkTestModChange changeLayoutLet3  "LayoutLet3.hs"
  , mkTestModChange changeLayoutLet3  "LayoutLet4.hs"
  , mkTestModChange changeRename1     "Rename1.hs"
  , mkTestModChange changeRename2     "Rename2.hs"
  , mkTestModChange changeLayoutIn1   "LayoutIn1.hs"
  , mkTestModChange changeLayoutIn3   "LayoutIn3.hs"
  , mkTestModChange changeLayoutIn3   "LayoutIn3a.hs"
  , mkTestModChange changeLayoutIn3   "LayoutIn3b.hs"
  , mkTestModChange changeLayoutIn4   "LayoutIn4.hs"
  , mkTestModChange changeLocToName   "LocToName.hs"
  , mkTestModChange changeLetIn1      "LetIn1.hs"
  , mkTestModChange changeWhereIn4    "WhereIn4.hs"
  , mkTestModChange changeAddDecl     "AddDecl.hs"
  , mkTestModChange changeLocalDecls  "LocalDecls.hs"
  , mkTestModChange changeLocalDecls2 "LocalDecls2.hs"
  , mkTestModChange changeWhereIn3a   "WhereIn3a.hs"
--  , mkTestModChange changeCifToCase  "C.hs"          "C"
  ]

mkTestModChange :: Changer -> FilePath -> Test
mkTestModChange = mkTestMod "expected" "transform"

mkTestModBad :: FilePath -> Test
mkTestModBad = mkTestMod "bad" "failing" noChange


mkTestMod :: String -> FilePath -> Changer -> FilePath ->  Test
mkTestMod suffix dir f fp =
  let basename       = testPrefix </> dir </> fp
      expected       = basename <.> suffix
      writeFailure   = writeFile (basename <.> "out")
  in
    TestCase (do r <- either (\(ParseFailure _ s) -> error (s ++ basename)) id
                        <$> genTest f basename expected
                 writeFailure (debugTxt r)
                 assertBool fp (status r == Success))


-- ---------------------------------------------------------------------

changeWhereIn3a :: Changer
changeWhereIn3a ans (GHC.L l p) = do
  let decls = GHC.hsmodDecls p
         -- (GHC.L _ (GHC.SigD sig))    = head $ drop 1 decls
      d1 = head $ drop 2 decls
      d2 = head $ drop 3 decls
  let (_p1,(ans',_),_w) = runTransform ans (balanceComments d1 d2)
  let p2 = p { GHC.hsmodDecls = d2:d1:decls}
  return (ans',GHC.L l p2)

-- ---------------------------------------------------------------------

-- | Add a local declaration with signature to LocalDecl, where there was no
-- prior local decl. So it adds a "where" annotation.
changeLocalDecls2 :: Changer
changeLocalDecls2 ans (GHC.L l p) = do
#if __GLASGOW_HASKELL__ > 804
  Right (declAnns, d@(GHC.L ld (GHC.ValD _ decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
  Right (sigAnns, s@(GHC.L ls (GHC.SigD _ sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")
#else
  Right (declAnns, d@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
  Right (sigAnns, s@(GHC.L ls (GHC.SigD sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")
#endif
  let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
  let  sigAnns' = setPrecedingLines (GHC.L ls  sig) 1 4 sigAnns
  -- putStrLn $ "changeLocalDecls:sigAnns=" ++ show sigAnns
  -- putStrLn $ "changeLocalDecls:declAnns=" ++ show declAnns
  -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'
  let (p',(ans',_),_w) = runTransform ans doAddLocal
      doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p
      replaceLocalBinds :: GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
                        -> Transform (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
#if __GLASGOW_HASKELL__ <= 710
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.EmptyLocalBinds)))) = do
#elif __GLASGOW_HASKELL__ <= 802
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L _ GHC.EmptyLocalBinds)))) = do
#elif __GLASGOW_HASKELL__ <= 804
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L _ GHC.EmptyLocalBinds)))) = do
#else
      replaceLocalBinds m@(GHC.L lm (GHC.Match _ mln pats (GHC.GRHSs _ rhs (GHC.L _ GHC.EmptyLocalBinds{})))) = do
#endif
        newSpan <- uniqueSrcSpanT
        let
          newAnnKey = AnnKey newSpan (CN "HsValBinds")
          addWhere mkds =
            case Map.lookup (mkAnnKey m) mkds of
              Nothing -> error "wtf"
              Just ann -> Map.insert newAnnKey ann2 mkds2
                where
                  ann1 = ann { annsDP = annsDP ann ++ [(G GHC.AnnWhere,DP (1,2))]
                             , annCapturedSpan = Just newAnnKey
                             , annSortKey = Just [ls, ld]
                             }
                  mkds2 = Map.insert (mkAnnKey m) ann1 mkds
                  ann2 = annNone
                             { annEntryDelta     = DP (1,0) }
        modifyAnnsT addWhere
        let decls = [s,d]
        -- logTr $ "(m,decls)=" ++ show (mkAnnKey m,map mkAnnKey decls)
        modifyAnnsT (captureOrderAnnKey newAnnKey decls)
#if __GLASGOW_HASKELL__ > 804
        let binds = (GHC.HsValBinds GHC.noExt (GHC.ValBinds GHC.noExt (GHC.listToBag $ [GHC.L ld decl])
                                    [GHC.L ls sig]))
#else
        let binds = (GHC.HsValBinds (GHC.ValBindsIn (GHC.listToBag $ [GHC.L ld decl])
                                    [GHC.L ls sig]))
#endif
#if __GLASGOW_HASKELL__ <= 710
        return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs binds)))
#elif __GLASGOW_HASKELL__ <= 802
        bindSpan <- uniqueSrcSpanT
        return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L bindSpan binds))))
#elif __GLASGOW_HASKELL__ <= 804
        bindSpan <- uniqueSrcSpanT
        return (GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L bindSpan binds))))
#else
        bindSpan <- uniqueSrcSpanT
        return (GHC.L lm (GHC.Match GHC.noExt mln pats (GHC.GRHSs GHC.noExt rhs (GHC.L bindSpan binds))))
#endif
      replaceLocalBinds x = return x
  -- putStrLn $ "log:" ++ intercalate "\n" w
  return (mergeAnnList [declAnns',sigAnns',ans'],GHC.L l p')

-- ---------------------------------------------------------------------

-- | Add a local declaration with signature to LocalDecl
changeLocalDecls :: Changer
changeLocalDecls ans (GHC.L l p) = do
#if __GLASGOW_HASKELL__ > 804
  Right (declAnns, d@(GHC.L ld (GHC.ValD _ decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
  Right (sigAnns, s@(GHC.L ls (GHC.SigD _ sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")
#else
  Right (declAnns, d@(GHC.L ld (GHC.ValD decl))) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
  Right (sigAnns, s@(GHC.L ls (GHC.SigD sig)))   <- withDynFlags (\df -> parseDecl df "sig"  "nn :: Int")
#endif
  let declAnns' = setPrecedingLines (GHC.L ld decl) 1 0 declAnns
  let  sigAnns' = setPrecedingLines (GHC.L ls  sig) 1 4 sigAnns
  -- putStrLn $ "changeLocalDecls:sigAnns=" ++ show sigAnns
  -- putStrLn $ "changeLocalDecls:declAnns=" ++ show declAnns
  -- putStrLn $ "\nchangeLocalDecls:sigAnns'=" ++ show sigAnns'
  let (p',(ans',_),_w) = runTransform ans doAddLocal
      doAddLocal = SYB.everywhereM (SYB.mkM replaceLocalBinds) p
      replaceLocalBinds :: GHC.LMatch GhcPs (GHC.LHsExpr GhcPs)
                        -> Transform (GHC.LMatch GhcPs (GHC.LHsExpr GhcPs))
#if __GLASGOW_HASKELL__ <= 710
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.HsValBinds (GHC.ValBindsIn binds sigs))))) = do
#elif __GLASGOW_HASKELL__ <= 802
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn binds sigs)))))) = do
#elif __GLASGOW_HASKELL__ <= 804
      replaceLocalBinds m@(GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn binds sigs)))))) = do
#else
      replaceLocalBinds m@(GHC.L lm (GHC.Match _ mln pats (GHC.GRHSs _ rhs (GHC.L lb (GHC.HsValBinds _ (GHC.ValBinds _ binds sigs)))))) = do
#endif
        a1 <- getAnnsT
        a' <- case sigs of
              []    -> return a1
              (s1:_) -> do
                let a2 = setPrecedingLines s1 2 0 a1
                return a2
        putAnnsT a'
        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)
        modifyAnnsT (captureOrder m decls)
#if __GLASGOW_HASKELL__ > 804
        let binds' = (GHC.HsValBinds GHC.noExt
                          (GHC.ValBinds GHC.noExt (GHC.listToBag $ (GHC.L ld decl):GHC.bagToList binds)
                                          (GHC.L ls sig:sigs)))
#else
        let binds' = (GHC.HsValBinds
                          (GHC.ValBindsIn (GHC.listToBag $ (GHC.L ld decl):GHC.bagToList binds)
                                          (GHC.L ls sig:sigs)))
#endif
#if __GLASGOW_HASKELL__ <= 710
        return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs binds')))
#elif __GLASGOW_HASKELL__ <= 802
        return (GHC.L lm (GHC.Match mln pats typ (GHC.GRHSs rhs (GHC.L lb binds'))))
#elif __GLASGOW_HASKELL__ <= 804
        return (GHC.L lm (GHC.Match mln pats (GHC.GRHSs rhs (GHC.L lb binds'))))
#else
        return (GHC.L lm (GHC.Match GHC.noExt mln pats (GHC.GRHSs GHC.noExt rhs (GHC.L lb binds'))))
#endif
      replaceLocalBinds x = return x
  -- putStrLn $ "log:" ++ intercalate "\n" w
  return (mergeAnnList [declAnns',sigAnns',ans'],GHC.L l p')

-- ---------------------------------------------------------------------

-- | Add a declaration to AddDecl
changeAddDecl :: Changer
changeAddDecl ans top = do
  Right (declAnns, decl) <- withDynFlags (\df -> parseDecl df "<interactive>" "nn = n2")
  -- putStrLn $ "changeDecl:(declAnns,decl)=" ++ showGhc (declAnns,decl)
  let declAnns' = setPrecedingLines decl 2 0 declAnns
  -- putStrLn $ "changeDecl:(declAnns',decl)=" ++ showGhc (declAnns',decl)

  let (p',(ans',_),_) = runTransform ans doAddDecl
      doAddDecl = SYB.everywhereM (SYB.mkM replaceTopLevelDecls) top
      replaceTopLevelDecls :: GHC.ParsedSource -> Transform (GHC.ParsedSource)
      replaceTopLevelDecls m = insertAtStart m decl
  return (mergeAnns declAnns' ans',p')

-- ---------------------------------------------------------------------

-- |Remove a decl with a trailing comment, and remove the trailing comment too
changeWhereIn3 :: Int -> Changer
changeWhereIn3 declIndex ans p = return (ans',p')
  where
    (p',(ans',_),_) = runTransform ans doTransform
    doTransform = doRmDecl p

    doRmDecl (GHC.L l (GHC.HsModule mmn mexp imps decls mdepr haddock)) = do
      let
        -- declIndex = 2 -- zero based
        decls1 = take declIndex decls
        decls2 = drop (declIndex + 1) decls
        decls' = decls1 ++ decls2
      return (GHC.L l (GHC.HsModule mmn mexp imps decls' mdepr haddock))
      -- error $ "doRmDecl:decls2=" ++ showGhc (length decls,decls1,decls2)

-- ---------------------------------------------------------------------

changeRenameCase1 :: Changer
changeRenameCase1 ans parsed = return (ans,rename "bazLonger" [((3,15),(3,18))] parsed)

changeRenameCase2 :: Changer
changeRenameCase2 ans parsed = return (ans,rename "fooLonger" [((3,1),(3,4))] parsed)

changeLayoutLet2 :: Changer
changeLayoutLet2 ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)

changeLocToName :: Changer
changeLocToName ans parsed = return (ans,rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)

changeLayoutIn3 :: Changer
changeLayoutIn3 ans parsed = return (ans,rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
-- changeLayoutIn3 parsed = rename "anotherX" [((7,13),(7,14)),((7,37),(7,38))] parsed

changeLayoutIn4 :: Changer
changeLayoutIn4 ans parsed = return (ans,rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)

changeLayoutIn1 :: Changer
changeLayoutIn1 ans parsed = return (ans,rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)

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)

changeLayoutLet5 :: Changer
changeLayoutLet5 ans parsed = return (ans,rename "x" [((7,5),(7,8)),((9,14),(9,17))] parsed)

-- AZ:TODO: the GHC 8 version only needs to consider Located RdrName
rename :: (SYB.Data a) => String -> [(Pos, Pos)] -> a -> a
rename newNameStr spans a
  = SYB.everywhere ( SYB.mkT   replaceRdr
                    `SYB.extT` replaceHsVar
                    `SYB.extT` replacePat
                   ) a
  where
    newName = GHC.mkRdrUnqual (GHC.mkVarOcc newNameStr)

    cond :: GHC.SrcSpan -> Bool
    cond ln = ln `elem` srcSpans
      where
        srcSpans  = map (\(start, end) -> GHC.mkSrcSpan (f start) (f end)) spans
        fname = fromMaybe (GHC.mkFastString "f") (GHC.srcSpanFileName_maybe ln)
        f = uncurry (GHC.mkSrcLoc fname)


    replaceRdr :: GHC.Located GHC.RdrName -> GHC.Located GHC.RdrName
    replaceRdr (GHC.L ln _)
        | cond ln = GHC.L ln newName
    replaceRdr x = x

    replaceHsVar :: GHC.LHsExpr GhcPs -> GHC.LHsExpr GhcPs
    replaceHsVar (GHC.L ln (GHC.HsVar{}))
#if __GLASGOW_HASKELL__ <= 710
        | cond ln = GHC.L ln (GHC.HsVar newName)
#elif __GLASGOW_HASKELL__ <= 804
        | cond ln = GHC.L ln (GHC.HsVar (GHC.L ln newName))
#else
        | cond ln = GHC.L ln (GHC.HsVar GHC.noExt (GHC.L ln newName))
#endif
    replaceHsVar x = x



#if __GLASGOW_HASKELL__ > 806
    replacePat :: GHC.LPat GhcPs -> GHC.LPat GhcPs
    replacePat (GHC.dL->GHC.L ln (GHC.VarPat {}))
        | cond ln = GHC.cL ln (GHC.VarPat GHC.noExt (GHC.cL ln newName))
#elif __GLASGOW_HASKELL__ > 804
    replacePat :: GHC.LPat GhcPs -> GHC.LPat GhcPs
    replacePat (GHC.L ln (GHC.VarPat {}))
        | cond ln = GHC.L ln (GHC.VarPat GHC.noExt (GHC.L ln newName))
#elif __GLASGOW_HASKELL__ > 802
    replacePat :: GHC.LPat GhcPs -> GHC.LPat GhcPs
    replacePat (GHC.L ln (GHC.VarPat {}))
        | cond ln = GHC.L ln (GHC.VarPat (GHC.L ln newName))
#elif __GLASGOW_HASKELL__ >= 800
    replacePat (GHC.L ln (GHC.VarPat {}))
        | cond ln = GHC.L ln (GHC.VarPat (GHC.L ln newName))
#else
    replacePat (GHC.L ln (GHC.VarPat {}))
        | cond ln = GHC.L ln (GHC.VarPat newName)
#endif
    replacePat x = x



-- #if __GLASGOW_HASKELL__ > 802
--     replacePat :: GHC.LPat GhcPs -> GHC.LPat GhcPs
-- #endif
--     replacePat (GHC.L ln (GHC.VarPat {}))
-- #if __GLASGOW_HASKELL__ <= 710
--         | cond ln = GHC.L ln (GHC.VarPat newName)
-- #elif __GLASGOW_HASKELL__ <= 804
--         | cond ln = GHC.L ln (GHC.VarPat (GHC.L ln newName))
-- #else
--         | cond ln = GHC.L ln (GHC.VarPat GHC.noExt (GHC.L ln newName))
-- #endif
--     replacePat x = x



-- ---------------------------------------------------------------------

changeWhereIn4 :: Changer
changeWhereIn4 ans parsed
  = return (ans,SYB.everywhere (SYB.mkT replace) parsed)
  where
    replace :: GHC.Located GHC.RdrName -> GHC.Located GHC.RdrName
    replace (GHC.L ln _n)
      | ln == (g (12,16) (12,17)) = GHC.L ln (GHC.mkRdrUnqual (GHC.mkVarOcc "p_2"))
      where
        g start end = GHC.mkSrcSpan (f start) (f end)
        fname = fromMaybe (GHC.mkFastString "f") (GHC.srcSpanFileName_maybe ln)
        f = uncurry (GHC.mkSrcLoc fname)
    replace x = x

-- ---------------------------------------------------------------------

changeLetIn1 :: Changer
changeLetIn1 ans parsed
  = return (ans,SYB.everywhere (SYB.mkT replace) parsed)
  where
    replace :: GHC.HsExpr GhcPs -> GHC.HsExpr GhcPs
#if __GLASGOW_HASKELL__ <= 710
    replace (GHC.HsLet localDecls expr@(GHC.L _ _))
#elif __GLASGOW_HASKELL__ <= 804
    replace (GHC.HsLet (GHC.L lb localDecls) expr@(GHC.L _ _))
#else
    replace (GHC.HsLet _ (GHC.L lb localDecls) expr@(GHC.L _ _))
#endif
      =
#if __GLASGOW_HASKELL__ > 804
         let (GHC.HsValBinds x (GHC.ValBinds xv bagDecls sigs)) = localDecls
             bagDecls' = GHC.listToBag $ init $ GHC.bagToList bagDecls
#else
         let (GHC.HsValBinds (GHC.ValBindsIn bagDecls sigs)) = localDecls
             bagDecls' = GHC.listToBag $ init $ GHC.bagToList bagDecls
#endif
#if __GLASGOW_HASKELL__ <= 710
         in (GHC.HsLet (GHC.HsValBinds (GHC.ValBindsIn bagDecls' sigs)) expr)
#elif __GLASGOW_HASKELL__ <= 802
         in (GHC.HsLet (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn bagDecls' sigs))) expr)
#elif __GLASGOW_HASKELL__ <= 804
         in (GHC.HsLet (GHC.L lb (GHC.HsValBinds (GHC.ValBindsIn bagDecls' sigs))) expr)
#else
         in (GHC.HsLet GHC.noExt (GHC.L lb (GHC.HsValBinds x (GHC.ValBinds xv bagDecls' sigs))) expr)
#endif

    replace x = x

-- ---------------------------------------------------------------------

transformHighLevelTests :: [Test]
transformHighLevelTests =
  [
    mkTestModChange addLocaLDecl1  "AddLocalDecl1.hs"
  , mkTestModChange addLocaLDecl2  "AddLocalDecl2.hs"
  , mkTestModChange addLocaLDecl3  "AddLocalDecl3.hs"
  , mkTestModChange addLocaLDecl4  "AddLocalDecl4.hs"
  , mkTestModChange addLocaLDecl5  "AddLocalDecl5.hs"
  , mkTestModChange addLocaLDecl6  "AddLocalDecl6.hs"

  , mkTestModChange rmDecl1 "RmDecl1.hs"
  , mkTestModChange rmDecl2 "RmDecl2.hs"
  , mkTestModChange rmDecl3 "RmDecl3.hs"
  , mkTestModChange rmDecl4 "RmDecl4.hs"
  , mkTestModChange rmDecl5 "RmDecl5.hs"
  , mkTestModChange rmDecl6 "RmDecl6.hs"
  , mkTestModChange rmDecl7 "RmDecl7.hs"

  , mkTestModChange rmTypeSig1 "RmTypeSig1.hs"
  , mkTestModChange rmTypeSig2 "RmTypeSig2.hs"

  , mkTestModChange addHiding1 "AddHiding1.hs"
  , mkTestModChange addHiding2 "AddHiding2.hs"

  , mkTestModChange cloneDecl1 "CloneDecl1.hs"
  ]

-- ---------------------------------------------------------------------

addLocaLDecl1 :: Changer
addLocaLDecl1 ans lp = do
  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]

  (lp',(ans',_),_w) <- runTransformT (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
         balanceComments parent (head $ tail tlDecs)

         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
           transferEntryDPT (head decls) newDecl
           setEntryDPT (head decls) (DP (1, 0))
           return ((newDecl:decls),Nothing)

         replaceDecls lp (parent':tail tlDecs)

  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) <- withDynFlags (\df -> parseDecl df "decl" "nn = 2")
  let
      doAddLocal = do
         -- logDataWithAnnsTr "parsed:" lp
         logDataWithAnnsTr "newDecl:" newDecl
         tlDecs <- hsDecls lp
         let parent = head tlDecs
         balanceComments parent (head $ tail tlDecs)

         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \m decls -> do
           setPrecedingLinesT newDecl 1 0
           moveTrailingComments m (last decls)
           return ((decls++[newDecl]),Nothing)

         replaceDecls lp (parent':tail tlDecs)

  let (lp',(ans',_),_w) = runTransform (mergeAnns ans declAnns) doAddLocal
  -- putStrLn $ "log\n" ++ intercalate "\n" _w
  return (ans',lp')

-- ---------------------------------------------------------------------

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

         setPrecedingLinesT newSig  1 0
         setPrecedingLinesT newDecl 1 0

         (parent',_) <- modifyValD (GHC.getLoc parent) parent $ \_m decls -> do
           return ((decls++[newSig,newDecl]),Nothing)

         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]

  (lp',(ans',_),_w) <- runTransformT ans doAddLocal
  -- 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

#if __GLASGOW_HASKELL__ <= 710
        let GHC.L _ (GHC.ValD (GHC.FunBind  _ _ (GHC.MG [m1,m2] _ _ _) _ _ _)) = d1
#elif __GLASGOW_HASKELL__ <= 804
        let GHC.L _ (GHC.ValD (GHC.FunBind  _ (GHC.MG (GHC.L _ [m1,m2]) _ _ _) _ _ _)) = d1
#else
        let GHC.L _ (GHC.ValD _ (GHC.FunBind _ _ (GHC.MG _ (GHC.L _ [m1,m2]) _) _ _)) = d1
#endif
        balanceComments m1 m2

        (d1',_) <- modifyValD (GHC.getLoc m1) d1 $ \_m decls -> do
           return ((newDecl : decls),Nothing)
        replaceDecls lp [d1', d2]

  (lp',(ans',_),_w) <- runTransformT (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 (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')

  (lp',(ans',_),_w) <- runTransformT ans doRmDecl
  return (ans',lp')

-- ---------------------------------------------------------------------

rmDecl2 :: Changer
rmDecl2 ans lp = do
  let
      doRmDecl = do
        let
          go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)
          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]

  (lp',(ans',_),_w) <- runTransformT 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]

  (lp',(ans',_),_w) <- runTransformT ans doRmDecl
  return (ans',lp')

-- ---------------------------------------------------------------------

rmDecl5 :: Changer
rmDecl5 ans lp = do
  let
      doRmDecl = do
        let
          go :: GHC.HsExpr GhcPs -> Transform (GHC.HsExpr GhcPs)
#if __GLASGOW_HASKELL__ <= 710
          go (GHC.HsLet lb expr) = do
#elif __GLASGOW_HASKELL__ <= 804
          go (GHC.HsLet (GHC.L l lb) expr) = do
#else
          go (GHC.HsLet _ (GHC.L l lb) expr) = do
#endif
            decs <- hsDeclsValBinds lb
            let dec = last decs
            transferEntryDPT (head decs) dec
            lb' <- replaceDeclsValbinds lb [dec]
#if __GLASGOW_HASKELL__ <= 710
            return (GHC.HsLet lb' expr)
#elif __GLASGOW_HASKELL__ <= 804
            return (GHC.HsLet (GHC.L l lb') expr)
#else
            return (GHC.HsLet GHC.noExt (GHC.L l lb') expr)
#endif
          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')

-- ---------------------------------------------------------------------

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']

  (lp',(ans',_),_w) <- runTransformT ans doRmDecl
  -- putStrLn $ "log:" ++ intercalate "\n" _w
  return (ans',lp')

-- ---------------------------------------------------------------------

rmDecl7 :: Changer
rmDecl7 ans lp = do
  let
      doRmDecl = do
         tlDecs <- hsDecls lp
         let [s1,d1,d2,d3] = tlDecs

         balanceComments d1 d2
         balanceComments d2 d3

         transferEntryDPT d2 d3

         replaceDecls lp [s1,d1,d3]

  let (lp',(ans',_),_w) = runTransform ans doRmDecl
  -- putStrLn $ "log:" ++ intercalate "\n" _w
  return (ans',lp')

-- ---------------------------------------------------------------------

rmTypeSig1 :: Changer
rmTypeSig1 ans lp = do
  let doRmDecl = do
         tlDecs <- hsDecls lp
         let (s1:d1:d2) = tlDecs
#if __GLASGOW_HASKELL__ <= 710
             (GHC.L l (GHC.SigD (GHC.TypeSig names typ p))) = s1
             s1' = (GHC.L l (GHC.SigD (GHC.TypeSig (tail names) typ p)))
#elif __GLASGOW_HASKELL__ <= 804
             (GHC.L l (GHC.SigD (GHC.TypeSig names typ))) = s1
             s1' = (GHC.L l (GHC.SigD (GHC.TypeSig (tail names) typ)))
#else
             (GHC.L l (GHC.SigD x1 (GHC.TypeSig x2 names typ))) = s1
             s1' = (GHC.L l (GHC.SigD x1 (GHC.TypeSig x2 (tail names) typ)))
#endif
         replaceDecls lp (s1':d1:d2)

  let (lp',(ans',_),_w) = runTransform ans doRmDecl
  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"))
#if __GLASGOW_HASKELL__ > 804
          v1 = GHC.L l1 (GHC.IEVar GHC.noExt (GHC.L l1 (GHC.IEName n1)))
          v2 = GHC.L l2 (GHC.IEVar GHC.noExt (GHC.L l2 (GHC.IEName n2)))
#elif __GLASGOW_HASKELL__ > 800
          v1 = GHC.L l1 (GHC.IEVar (GHC.L l1 (GHC.IEName n1)))
          v2 = GHC.L l2 (GHC.IEVar (GHC.L l2 (GHC.IEName n2)))
#else
          v1 = GHC.L l1 (GHC.IEVar n1)
          v2 = GHC.L l2 (GHC.IEVar n2)
#endif
          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))]
        addSimpleAnnT v1        (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
          n1 = GHC.L l1 (GHC.mkVarUnqual (GHC.mkFastString "n1"))
          n2 = GHC.L l2 (GHC.mkVarUnqual (GHC.mkFastString "n2"))
#if __GLASGOW_HASKELL__ > 804
          v1 = GHC.L l1 (GHC.IEVar GHC.noExt (GHC.L l1 (GHC.IEName n1)))
          v2 = GHC.L l2 (GHC.IEVar GHC.noExt (GHC.L l2 (GHC.IEName n2)))
#elif __GLASGOW_HASKELL__ > 800
          v1 = GHC.L l1 (GHC.IEVar (GHC.L l1 (GHC.IEName n1)))
          v2 = GHC.L l2 (GHC.IEVar (GHC.L l2 (GHC.IEName n2)))
#else
          v1 = GHC.L l1 (GHC.IEVar n1)
          v2 = GHC.L l2 (GHC.IEVar n2)
#endif
          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))]
        addSimpleAnnT v1        (DP (0,0)) [((G GHC.AnnComma),DP (0,0))]
        addSimpleAnnT n2        (DP (0,0)) [((G GHC.AnnVal),DP (0,0))]
        addTrailingCommaT (last ns)
        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')

-- ---------------------------------------------------------------------