summaryrefslogtreecommitdiff
path: root/utils
diff options
context:
space:
mode:
authorGHC GitLab CI <ghc-ci@gitlab-haskell.org>2021-03-21 22:58:14 +0000
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-03-23 20:44:11 -0400
commit25306ddc00c2236564bcfebd55a3f61ffa6d182e (patch)
tree432ee092c243c4963c5c804a2926da924aece70b /utils
parentdf895b3f972e0062a81c8c136fa9fdd79badea5c (diff)
downloadhaskell-25306ddc00c2236564bcfebd55a3f61ffa6d182e.tar.gz
EPA: Run exactprint transformation tests as part of CI
EPA == exact print annotations. When !2418 landed, it did not run the tests brought over from ghc-exactprint for making sure the AST prints correctly efter being edited. This enables those tests.
Diffstat (limited to 'utils')
-rw-r--r--utils/check-exact/Main.hs1022
-rw-r--r--utils/check-exact/Test.hs840
-rw-r--r--utils/check-exact/cases/AddDecl1.expected.hs13
-rw-r--r--utils/check-exact/cases/AddDecl1.hs11
-rw-r--r--utils/check-exact/cases/AddDecl2.expected.hs13
-rw-r--r--utils/check-exact/cases/AddDecl2.hs11
-rw-r--r--utils/check-exact/cases/AddDecl3.expected.hs13
-rw-r--r--utils/check-exact/cases/AddDecl3.hs11
-rw-r--r--utils/check-exact/cases/AddHiding1.expected.hs8
-rw-r--r--utils/check-exact/cases/AddHiding1.hs8
-rw-r--r--utils/check-exact/cases/AddHiding2.expected.hs5
-rw-r--r--utils/check-exact/cases/AddHiding2.hs5
-rw-r--r--utils/check-exact/cases/AddLocalDecl1.expected.hs15
-rw-r--r--utils/check-exact/cases/AddLocalDecl1.hs13
-rw-r--r--utils/check-exact/cases/AddLocalDecl2.expected.hs11
-rw-r--r--utils/check-exact/cases/AddLocalDecl2.hs10
-rw-r--r--utils/check-exact/cases/AddLocalDecl3.expected.hs13
-rw-r--r--utils/check-exact/cases/AddLocalDecl3.hs12
-rw-r--r--utils/check-exact/cases/AddLocalDecl4.expected.hs6
-rw-r--r--utils/check-exact/cases/AddLocalDecl4.hs3
-rw-r--r--utils/check-exact/cases/AddLocalDecl5.expected.hs9
-rw-r--r--utils/check-exact/cases/AddLocalDecl5.hs8
-rw-r--r--utils/check-exact/cases/AddLocalDecl6.expected.hs12
-rw-r--r--utils/check-exact/cases/AddLocalDecl6.hs10
-rw-r--r--utils/check-exact/cases/EmptyWheres.hs9
-rw-r--r--utils/check-exact/cases/LayoutIn1.expected.hs9
-rw-r--r--utils/check-exact/cases/LayoutIn1.hs9
-rw-r--r--utils/check-exact/cases/LayoutIn3.expected.hs13
-rw-r--r--utils/check-exact/cases/LayoutIn3.hs13
-rw-r--r--utils/check-exact/cases/LayoutIn3a.expected.hs13
-rw-r--r--utils/check-exact/cases/LayoutIn3a.hs13
-rw-r--r--utils/check-exact/cases/LayoutIn3b.expected.hs12
-rw-r--r--utils/check-exact/cases/LayoutIn3b.hs12
-rw-r--r--utils/check-exact/cases/LayoutIn4.expected.hs13
-rw-r--r--utils/check-exact/cases/LayoutIn4.hs13
-rw-r--r--utils/check-exact/cases/LayoutLet2.expected.hs8
-rw-r--r--utils/check-exact/cases/LayoutLet2.hs8
-rw-r--r--utils/check-exact/cases/LayoutLet3.expected.hs10
-rw-r--r--utils/check-exact/cases/LayoutLet3.hs10
-rw-r--r--utils/check-exact/cases/LayoutLet4.expected.hs12
-rw-r--r--utils/check-exact/cases/LayoutLet4.hs12
-rw-r--r--utils/check-exact/cases/LetIn1.expected.hs18
-rw-r--r--utils/check-exact/cases/LetIn1.hs19
-rw-r--r--utils/check-exact/cases/LocToName.expected.hs25
-rw-r--r--utils/check-exact/cases/LocToName.hs25
-rw-r--r--utils/check-exact/cases/LocalDecls.expected.hs11
-rw-r--r--utils/check-exact/cases/LocalDecls.hs8
-rw-r--r--utils/check-exact/cases/LocalDecls2.expected.hs8
-rw-r--r--utils/check-exact/cases/LocalDecls2.hs3
-rw-r--r--utils/check-exact/cases/Rename1.expected.hs6
-rw-r--r--utils/check-exact/cases/Rename1.hs6
-rw-r--r--utils/check-exact/cases/Rename2.expected.hs4
-rw-r--r--utils/check-exact/cases/Rename2.hs4
-rw-r--r--utils/check-exact/cases/RenameCase1.expected.hs5
-rw-r--r--utils/check-exact/cases/RenameCase1.hs5
-rw-r--r--utils/check-exact/cases/RmDecl1.expected.hs9
-rw-r--r--utils/check-exact/cases/RmDecl1.hs13
-rw-r--r--utils/check-exact/cases/RmDecl2.expected.hs9
-rw-r--r--utils/check-exact/cases/RmDecl2.hs10
-rw-r--r--utils/check-exact/cases/RmDecl3.expected.hs9
-rw-r--r--utils/check-exact/cases/RmDecl3.hs9
-rw-r--r--utils/check-exact/cases/RmDecl4.expected.hs10
-rw-r--r--utils/check-exact/cases/RmDecl4.hs9
-rw-r--r--utils/check-exact/cases/RmDecl5.expected.hs5
-rw-r--r--utils/check-exact/cases/RmDecl5.hs7
-rw-r--r--utils/check-exact/cases/RmDecl6.expected.hs9
-rw-r--r--utils/check-exact/cases/RmDecl6.hs12
-rw-r--r--utils/check-exact/cases/RmDecl7.expected.hs7
-rw-r--r--utils/check-exact/cases/RmDecl7.hs9
-rw-r--r--utils/check-exact/cases/RmTypeSig1.expected.hs8
-rw-r--r--utils/check-exact/cases/RmTypeSig1.hs8
-rw-r--r--utils/check-exact/cases/RmTypeSig2.expected.hs7
-rw-r--r--utils/check-exact/cases/RmTypeSig2.hs8
-rw-r--r--utils/check-exact/cases/WhereIn3a.expected.hs20
-rw-r--r--utils/check-exact/cases/WhereIn3a.hs20
-rw-r--r--utils/check-exact/cases/WhereIn3b.expected.hs27
-rw-r--r--utils/check-exact/cases/WhereIn3b.hs20
-rw-r--r--utils/check-exact/cases/WhereIn4.expected.hs19
-rw-r--r--utils/check-exact/cases/WhereIn4.hs19
-rw-r--r--utils/check-exact/cases/Windows.hs10
80 files changed, 868 insertions, 1843 deletions
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index d5583c6f23..23fb0a825e 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -1,206 +1,332 @@
+{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
--- import Data.List
--- import GHC.Types.SrcLoc
+import Data.List
+import Data.Data
+import GHC.Types.Name.Occurrence
+import GHC.Types.Name.Reader
import GHC hiding (moduleName)
import GHC.Driver.Ppr
import GHC.Driver.Session
import GHC.Hs.Dump
--- import qualified Control.Monad.IO.Class as GHC
--- import GHC.Types.SourceText
--- import GHC.Hs.Exact hiding (ExactPrint())
--- import GHC.Utils.Outputable hiding (space)
+import GHC.Data.Bag
import System.Environment( getArgs )
import System.Exit
import System.FilePath
import System.IO
+
+import Types
+import Utils
import ExactPrint
--- exactPrint = undefined
--- showPprUnsafe = undefined
+import Transform
+import Parsers
+
+import GHC.Parser.Lexer
+import GHC.Data.FastString
+import GHC.Types.SrcLoc
-- ---------------------------------------------------------------------
_tt :: IO ()
--- _tt = testOneFile "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib"
-_tt = testOneFile "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
--- _tt = testOneFile "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
-
- -- "../../testsuite/tests/printer/Ppr001.hs"
- -- "../../testsuite/tests/printer/Ppr002.hs"
- -- "../../testsuite/tests/printer/Ppr002a.hs"
- -- "../../testsuite/tests/printer/Ppr003.hs"
- -- "../../testsuite/tests/printer/Ppr004.hs"
- -- "../../testsuite/tests/printer/Ppr005.hs"
- -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs"
- -- "../../testsuite/tests/printer/Ppr006.hs"
- -- "../../testsuite/tests/printer/Ppr007.hs"
- -- "../../testsuite/tests/printer/Ppr008.hs"
- -- "../../testsuite/tests/hiefile/should_compile/hie008.hs"
- -- "../../testsuite/tests/printer/Ppr009.hs"
- -- "../../testsuite/tests/printer/Ppr011.hs"
- -- "../../testsuite/tests/printer/Ppr012.hs"
- -- "../../testsuite/tests/printer/Ppr013.hs"
- -- "../../testsuite/tests/printer/Ppr014.hs"
- -- "../../testsuite/tests/printer/Ppr015.hs"
- -- "../../testsuite/tests/printer/Ppr016.hs"
- -- "../../testsuite/tests/printer/Ppr017.hs"
- -- "../../testsuite/tests/printer/Ppr018.hs"
- -- "../../testsuite/tests/printer/Ppr019.hs"
- -- "../../testsuite/tests/printer/Ppr020.hs"
- -- "../../testsuite/tests/printer/Ppr021.hs"
- -- "../../testsuite/tests/printer/Ppr022.hs"
- -- "../../testsuite/tests/printer/Ppr023.hs"
- -- "../../testsuite/tests/printer/Ppr024.hs"
- -- "../../testsuite/tests/printer/Ppr025.hs"
- -- "../../testsuite/tests/printer/Ppr026.hs"
- -- "../../testsuite/tests/printer/Ppr027.hs"
- -- "../../testsuite/tests/printer/Ppr028.hs"
- -- "../../testsuite/tests/printer/Ppr029.hs"
- -- "../../testsuite/tests/printer/Ppr030.hs"
- -- "../../testsuite/tests/printer/Ppr031.hs"
- -- "../../testsuite/tests/printer/Ppr032.hs"
- -- "../../testsuite/tests/printer/Ppr033.hs"
- -- "../../testsuite/tests/printer/Ppr034.hs"
- -- "../../testsuite/tests/printer/Ppr035.hs"
- "../../testsuite/tests/printer/Ppr036.hs"
- -- "../../testsuite/tests/printer/Ppr037.hs"
- -- "../../testsuite/tests/printer/Ppr038.hs"
- -- "../../testsuite/tests/printer/Ppr039.hs"
- -- "../../testsuite/tests/printer/Ppr040.hs"
- -- "../../testsuite/tests/printer/Ppr041.hs"
- -- "../../testsuite/tests/printer/Ppr042.hs"
- -- "../../testsuite/tests/printer/Ppr043.hs"
- -- "../../testsuite/tests/printer/Ppr044.hs"
- -- "../../testsuite/tests/printer/Ppr045.hs"
- -- "../../testsuite/tests/printer/Ppr046.hs"
- -- Not tested, the GENERATED pragma is getting removed "../../testsuite/tests/printer/Ppr047.hs"
- -- "../../testsuite/tests/printer/Ppr048.hs"
- -- "../../testsuite/tests/printer/Ppr049.hs"
- -- "../../testsuite/tests/printer/T13050p.hs"
- -- "../../testsuite/tests/printer/T13199.hs"
- -- "../../testsuite/tests/printer/T13550.hs"
- -- "../../testsuite/tests/printer/T13942.hs"
- -- "../../testsuite/tests/printer/T14289b.hs"
- -- "../../testsuite/tests/printer/T14289c.hs"
- -- "../../testsuite/tests/printer/T14289.hs"
- -- "../../testsuite/tests/printer/T14306.hs"
- -- "../../testsuite/tests/printer/T14343b.hs"
- -- "../../testsuite/tests/printer/T14343.hs"
- -- "../../testsuite/tests/printer/T15761.hs"
- -- "../../testsuite/tests/printer/Test17519.hs"
- -- "../../testsuite/tests/printer/T18052a.hs"
- -- "../../testsuite/tests/printer/T18247a.hs"
- -- "../../testsuite/tests/printer/Ppr050.hs"
- -- "../../testsuite/tests/printer/Ppr051.hs"
- -- "../../testsuite/tests/printer/Ppr052.hs"
- -- "../../testsuite/tests/typecheck/should_fail/T17566c.hs"
- -- "../../testsuite/tests/hiefile/should_compile/Constructors.hs"
- -- "../../testsuite/tests/printer/StarBinderAnns.hs"
- -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs"
- -- "../../testsuite/tests/printer/Test10276.hs"
- -- "../../testsuite/tests/printer/Test10278.hs"
- -- "../../testsuite/tests/printer/Test12417.hs"
- -- "../../testsuite/tests/parser/should_compile/T14189.hs"
- -- "../../testsuite/tests/printer/Test16212.hs"
- -- "../../testsuite/tests/printer/Test10312.hs"
- -- "../../testsuite/tests/printer/Test10354.hs"
- -- "../../testsuite/tests/printer/Test10357.hs"
- -- "../../testsuite/tests/printer/Test10399.hs"
- -- "../../testsuite/tests/printer/Test11018.hs"
- -- "../../testsuite/tests/printer/Test11332.hs"
- -- "../../testsuite/tests/printer/Test16230.hs"
- -- "../../testsuite/tests/printer/Test16236.hs"
- -- "../../testsuite/tests/printer/AnnotationLet.hs"
- -- "../../testsuite/tests/printer/AnnotationTuple.hs"
- -- "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs"
- -- "../../testsuite/tests/hiefile/should_compile/Scopes.hs"
- -- "../../testsuite/tests/printer/Ppr053.hs"
- -- "../../testsuite/tests/printer/Ppr054.hs"
- -- "../../testsuite/tests/printer/Ppr055.hs"
- -- "../../testsuite/tests/hiefile/should_run/PatTypes.hs"
- -- "./cases/LocalDecls2.expected.hs"
- -- "./cases/WhereIn3a.hs"
- -- "./cases/AddLocalDecl1.hs"
- -- "./cases/LayoutIn1.hs"
- -- "./cases/EmptyWheres.hs"
- -- "../../testsuite/tests/printer/PprRecordDotSyntax1.hs"
- -- "../../testsuite/tests/printer/PprRecordDotSyntax2.hs"
- -- "../../testsuite/tests/printer/PprRecordDotSyntax3.hs"
- -- "../../testsuite/tests/printer/PprRecordDotSyntax4.hs"
- -- "../../testsuite/tests/printer/PprRecordDotSyntaxA.hs"
- -- "./cases/Windows.hs"
+-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib"
+_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
+-- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
+ -- "../../testsuite/tests/ghc-api/exactprint/RenameCase1.hs" changeRenameCase1
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet2.hs" changeLayoutLet2
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet3.hs" changeLayoutLet3
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet4.hs" changeLayoutLet3
+ -- "../../testsuite/tests/ghc-api/exactprint/Rename1.hs" changeRename1
+ -- "../../testsuite/tests/ghc-api/exactprint/Rename2.hs" changeRename2
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn1.hs" changeLayoutIn1
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3.hs" changeLayoutIn3
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3a.hs" changeLayoutIn3
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3b.hs" changeLayoutIn3
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn4.hs" changeLayoutIn4
+ -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" changeLocToName
+ -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" changeLetIn1
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" changeWhereIn4
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" changeAddDecl1
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" changeAddDecl2
+ -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" changeAddDecl3
+ -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" changeLocalDecls
+ -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" changeLocalDecls2
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" changeWhereIn3a
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" changeWhereIn3b
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" addLocaLDecl1
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl2.hs" addLocaLDecl2
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" addLocaLDecl3
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" addLocaLDecl4
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" addLocaLDecl5
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6)
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" rmDecl1
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" rmDecl2
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" rmDecl3
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" rmDecl4
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl5.hs" rmDecl5
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl6.hs" rmDecl6
+ -- "../../testsuite/tests/ghc-api/exactprint/RmDecl7.hs" rmDecl7
+ -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig1.hs" rmTypeSig1
+ -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" rmTypeSig2
+ -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" addHiding1
+ -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" addHiding2
+ -- "../../testsuite/tests/printer/Ppr001.hs" Nothing
+
+ "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs" Nothing
+ -- "../../testsuite/tests/hiefile/should_compile/Constructors.hs" Nothing
+ -- "../../testsuite/tests/hiefile/should_compile/Scopes.hs" Nothing
+ -- "../../testsuite/tests/hiefile/should_compile/hie008.hs" Nothing
+ -- "../../testsuite/tests/hiefile/should_run/PatTypes.hs" Nothing
+ -- "../../testsuite/tests/parser/should_compile/T14189.hs" Nothing
+
+ -- "../../testsuite/tests/printer/AnnotationLet.hs" Nothing
+ -- "../../testsuite/tests/printer/AnnotationTuple.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr001.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr002.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr002a.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr003.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr004.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr005.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr006.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr007.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr008.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr009.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr011.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr012.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr013.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr014.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr015.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr016.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr017.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr018.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr019.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr020.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr021.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr022.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr023.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr024.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr025.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr026.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr027.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr028.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr029.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr030.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr031.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr032.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr033.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr034.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr035.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr036.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr037.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr038.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr039.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr040.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr041.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr042.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr043.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr044.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr045.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr046.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr048.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr049.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr050.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr051.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr052.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr053.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr054.hs" Nothing
+ -- "../../testsuite/tests/printer/Ppr055.hs" Nothing
+ -- "../../testsuite/tests/printer/PprRecordDotSyntax1.hs" Nothing
+ -- "../../testsuite/tests/printer/PprRecordDotSyntax2.hs" Nothing
+ -- "../../testsuite/tests/printer/PprRecordDotSyntax3.hs" Nothing
+ -- "../../testsuite/tests/printer/PprRecordDotSyntax4.hs" Nothing
+ -- "../../testsuite/tests/printer/PprRecordDotSyntaxA.hs" Nothing
+ -- "../../testsuite/tests/printer/StarBinderAnns.hs" Nothing
+ -- "../../testsuite/tests/printer/T13050p.hs" Nothing
+ -- "../../testsuite/tests/printer/T13199.hs" Nothing
+ -- "../../testsuite/tests/printer/T13550.hs" Nothing
+ -- "../../testsuite/tests/printer/T13942.hs" Nothing
+ -- "../../testsuite/tests/printer/T14289.hs" Nothing
+ -- "../../testsuite/tests/printer/T14289b.hs" Nothing
+ -- "../../testsuite/tests/printer/T14289c.hs" Nothing
+ -- "../../testsuite/tests/printer/T14306.hs" Nothing
+ -- "../../testsuite/tests/printer/T14343.hs" Nothing
+ -- "../../testsuite/tests/printer/T14343b.hs" Nothing
+ -- "../../testsuite/tests/printer/T15761.hs" Nothing
+ -- "../../testsuite/tests/printer/T18052a.hs" Nothing
+ -- "../../testsuite/tests/printer/T18247a.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10276.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10278.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10312.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10354.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10357.hs" Nothing
+ -- "../../testsuite/tests/printer/Test10399.hs" Nothing
+ -- "../../testsuite/tests/printer/Test11018.hs" Nothing
+ -- "../../testsuite/tests/printer/Test11332.hs" Nothing
+ -- "../../testsuite/tests/printer/Test12417.hs" Nothing
+ -- "../../testsuite/tests/printer/Test16212.hs" Nothing
+ -- "../../testsuite/tests/printer/Test16230.hs" Nothing
+ -- "../../testsuite/tests/printer/Test16236.hs" Nothing
+ -- "../../testsuite/tests/printer/Test17519.hs" Nothing
+
+ -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing
+ -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing
+ -- "../../testsuite/tests/typecheck/should_fail/T17566c.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/EmptyWheres.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn1.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.expected.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" Nothing
+ -- "../../testsuite/tests/ghc-api/exactprint/Windows.hs" Nothing
+
+-- cloneT does not need a test, function can be retired
+
-- exact = ppr
+changers :: [(String, Changer)]
+changers =
+ [("noChange", noChange)
+ ,("changeRenameCase1", changeRenameCase1)
+ ,("changeLayoutLet2", changeLayoutLet2)
+ ,("changeLayoutLet3", changeLayoutLet3)
+ ,("changeLayoutIn1", changeLayoutIn1)
+ ,("changeLayoutIn3", changeLayoutIn3)
+ ,("changeLayoutIn4", changeLayoutIn4)
+ ,("changeLocToName", changeLocToName)
+ ,("changeRename1", changeRename1)
+ ,("changeRename2", changeRename2)
+ ,("changeWhereIn4", changeWhereIn4)
+ ,("changeLetIn1", changeLetIn1)
+ ,("changeAddDecl1", changeAddDecl1)
+ ,("changeAddDecl2", changeAddDecl2)
+ ,("changeAddDecl3", changeAddDecl3)
+ ,("changeLocalDecls", changeLocalDecls)
+ ,("changeLocalDecls2", changeLocalDecls2)
+ ,("changeWhereIn3a", changeWhereIn3a)
+ ,("changeWhereIn3b", changeWhereIn3b)
+ ,("ADDLOCALDECL1", addLocaLDecl1)
+ ,("ADDLOCALDECL2", addLocaLDecl2)
+ ,("ADDLOCALDECL3", addLocaLDecl3)
+ ,("ADDLOCALDECL4", addLocaLDecl4)
+ ,("ADDLOCALDECL5", addLocaLDecl5)
+ ,("ADDLOCALDECL6", addLocaLDecl6)
+ ,("ADDLOCALDECL6", addLocaLDecl6)
+ ,("rmDecl1", rmDecl1)
+ ,("rmDecl2", rmDecl2)
+ ,("rmDecl3", rmDecl3)
+ ,("rmDecl4", rmDecl4)
+ ,("rmDecl5", rmDecl5)
+ ,("rmDecl6", rmDecl6)
+ ,("rmDecl7", rmDecl7)
+ ,("rmTypeSig1", rmTypeSig1)
+ ,("rmTypeSig2", rmTypeSig2)
+ ,("addHiding1", addHiding1)
+ ,("addHiding2", addHiding2)
+ ]
+
-- ---------------------------------------------------------------------
usage :: String
usage = unlines
- [ "usage: check-exact (libdir) (file)"
+ [ "usage: check-ppr (libdir) (file)"
+ , " check-ppr (libdir) (changer) (file)"
, ""
, "where libdir is the GHC library directory (e.g. the output of"
- , "ghc --print-libdir) and file is the file to parse."
+ , "ghc --print-libdir), file is the file to parse"
+ , "and changer is an optional name of a 'changer' to modify the"
+ , " AST before printing."
]
main :: IO()
main = do
args <- getArgs
case args of
- [libdir,fileName] -> testOneFile libdir fileName
+ [libdir,fileName] -> testOneFile changers libdir fileName Nothing
+ [libdir,fileName,changerStr] -> case lookup changerStr changers of
+ Just doChange -> testOneFile changers libdir fileName (Just doChange)
+ Nothing -> do
+ putStrLn $ "exactprint: could not find changer for [" ++ changerStr ++ "]"
+ putStrLn $ "valid changers are:\n" ++ unlines (map fst changers)
+ putStrLn $ "(see utils/check-exact/Main.hs)"
+ exitFailure
_ -> putStrLn usage
+deriving instance Data Token
+deriving instance Data PsSpan
+deriving instance Data BufSpan
+deriving instance Data BufPos
+
writeBinFile :: FilePath -> String -> IO()
writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h x)
-testOneFile :: FilePath -> String -> IO ()
-testOneFile libdir fileName = do
- p <- parseOneFile libdir fileName
- -- putStrLn $ "\n\ngot p"
+testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO ()
+testOneFile _ libdir fileName mchanger = do
+ (p,_toks) <- parseOneFile libdir fileName
+ -- putStrLn $ "\n\ngot p" ++ showAst (take 4 $ reverse toks)
let
- origAst = showSDocUnsafe
- $ showAstData BlankSrcSpanFile NoBlankApiAnnotations
- (pm_parsed_source p)
+ origAst = ppAst (pm_parsed_source p)
anns' = pm_annotations p
- -- pped = pragmas ++ "\n" ++ (exactPrint $ pm_parsed_source p)
pped = exactPrint (pm_parsed_source p) anns'
- -- pragmas = getPragmas anns'
- newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
- astFile = fileName <.> "ast"
- newAstFile = fileName <.> "ast.new"
+ newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
+ newFileChanged = dropExtension fileName <.> "changed" <.> takeExtension fileName
+ newFileExpected = dropExtension fileName <.> "expected" <.> takeExtension fileName
+ astFile = fileName <.> "ast"
+ newAstFile = fileName <.> "ast.new"
+ changedAstFile = fileName <.> "ast.changed"
- -- putStrLn $ "\n\nabout to writeFile"
writeBinFile astFile origAst
- -- putStrLn $ "\n\nabout to pp"
writeBinFile newFile pped
- -- putStrLn $ "anns':" ++ showPprUnsafe (apiAnnRogueComments anns')
+ (changedSourceOk, expectedSource, changedSource) <- case mchanger of
+ Just changer -> do
+ (pped', ast') <- exactprintWithChange libdir changer (pm_parsed_source p) anns'
+ writeBinFile changedAstFile (ppAst ast')
+ writeBinFile newFileChanged pped'
+
+ expectedSource <- readFile newFileExpected
+ changedSource <- readFile newFileChanged
+ return (expectedSource == changedSource, expectedSource, changedSource)
+ Nothing -> return (True, "", "")
- p' <- parseOneFile libdir newFile
+ (p',_) <- parseOneFile libdir newFile
let newAstStr :: String
- newAstStr = showSDocUnsafe
- $ showAstData BlankSrcSpanFile NoBlankApiAnnotations
- (pm_parsed_source p')
+ newAstStr = ppAst (pm_parsed_source p')
writeBinFile newAstFile newAstStr
- -- putStrLn $ "\n\nanns':" ++ showPprUnsafe (apiAnnRogueComments anns')
- if origAst == newAstStr
+ let
+ origAstOk = origAst == newAstStr
+ if origAstOk && changedSourceOk
then do
- -- putStrLn "ASTs matched"
exitSuccess
- else do
- putStrLn "exactPrint AST Match Failed"
- putStrLn "\n===================================\nOrig\n\n"
- putStrLn origAst
- putStrLn "\n===================================\nNew\n\n"
- putStrLn newAstStr
- putStrLn "\n===================================\n\n"
- exitFailure
+ else if not origAstOk
+ then do
+ putStrLn "exactPrint: AST Match Failed"
+ putStrLn "\n===================================\nOrig\n\n"
+ putStrLn origAst
+ putStrLn "\n===================================\nNew\n\n"
+ putStrLn newAstStr
+ exitFailure
+ else do
+ putStrLn "exactPrint: Changed AST Source Mismatch"
+ putStrLn "\n===================================\nExpected\n\n"
+ putStrLn expectedSource
+ putStrLn "\n===================================\nChanged\n\n"
+ putStrLn changedSource
+ putStrLn "\n===================================\n"
+ putStrLn $ show changedSourceOk
+ exitFailure
+ppAst :: Data a => a -> String
+ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankApiAnnotations ast
-parseOneFile :: FilePath -> FilePath -> IO ParsedModule
+parseOneFile :: FilePath -> FilePath -> IO (ParsedModule, [Located Token])
parseOneFile libdir fileName = do
let modByFile m =
case ml_hs_file $ ms_location m of
@@ -220,10 +346,11 @@ parseOneFile libdir fileName = do
[x] -> x
xs -> error $ "Can't find module, got:"
++ show (map (ml_hs_file . ms_location) xs)
- -- toks <- getRichTokenStream (ms_mod modSum)
- -- toks <- getTokenStream (ms_mod modSum)
- -- GHC.liftIO $ putStrLn $ "toks=" ++ showPprUnsafe toks
- parseModule modSum
+ pm <- GHC.parseModule modSum
+ toks <- getTokenStream (ms_mod modSum)
+ return (pm, toks)
+
+ -- getTokenStream :: GhcMonad m => Module -> m [Located Token]
-- getPragmas :: ApiAnns -> String
-- getPragmas anns' = pragmaStr
@@ -240,3 +367,590 @@ parseOneFile libdir fileName = do
-- pp a = showPpr unsafeGlobalDynFlags a
-- ---------------------------------------------------------------------
+
+exactprintWithChange :: FilePath -> Changer -> ParsedSource -> ApiAnns -> IO (String, ParsedSource)
+exactprintWithChange libdir f p apiAnns = do
+ debugM $ "exactprintWithChange:apiAnns=" ++ showGhc (apiAnnRogueComments apiAnns)
+ (apiAnns',p') <- f libdir apiAnns p
+ return (exactPrint p' apiAnns', p')
+
+-- First param is libdir
+type Changer = FilePath -> (ApiAnns -> ParsedSource -> IO (ApiAnns,ParsedSource))
+
+noChange :: Changer
+noChange _libdir ans parsed = return (ans,parsed)
+
+changeRenameCase1 :: Changer
+changeRenameCase1 _libdir ans parsed = return (ans,rename "bazLonger" [((3,15),(3,18))] parsed)
+
+changeLayoutLet2 :: Changer
+changeLayoutLet2 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)
+
+changeLayoutLet3 :: Changer
+changeLayoutLet3 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
+
+changeLayoutIn1 :: Changer
+changeLayoutIn1 _libdir ans parsed = return (ans,rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)
+
+changeLayoutIn3 :: Changer
+changeLayoutIn3 _libdir ans parsed = return (ans,rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
+
+changeLayoutIn4 :: Changer
+changeLayoutIn4 _libdir ans parsed = return (ans,rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)
+
+changeLocToName :: Changer
+changeLocToName _libdir ans parsed = return (ans,rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)
+
+
+changeRename1 :: Changer
+changeRename1 _libdir ans parsed = return (ans,rename "bar2" [((3,1),(3,4))] parsed)
+
+changeRename2 :: Changer
+changeRename2 _libdir ans parsed = return (ans,rename "joe" [((2,1),(2,5))] parsed)
+
+rename :: (Data a) => String -> [(Pos, Pos)] -> a -> a
+rename newNameStr spans' a
+ = everywhere (mkT replaceRdr) a
+ where
+ newName = mkRdrUnqual (mkVarOcc newNameStr)
+
+ cond :: SrcSpan -> Bool
+ cond ln = ss2range ln `elem` spans'
+
+ replaceRdr :: LocatedN RdrName -> LocatedN RdrName
+ replaceRdr (L ln _)
+ | cond (locA ln) = L ln newName
+ replaceRdr x = x
+
+-- ---------------------------------------------------------------------
+
+changeWhereIn4 :: Changer
+changeWhereIn4 _libdir ans parsed
+ = return (ans,everywhere (mkT replace) parsed)
+ where
+ replace :: LocatedN RdrName -> LocatedN RdrName
+ replace (L ln _n)
+ | ss2range (locA ln) == ((12,16),(12,17)) = L ln (mkRdrUnqual (mkVarOcc "p_2"))
+ replace x = x
+
+-- ---------------------------------------------------------------------
+
+changeLetIn1 :: Changer
+changeLetIn1 _libdir ans parsed
+ = return (ans,everywhere (mkT replace) parsed)
+ where
+ replace :: HsExpr GhcPs -> HsExpr GhcPs
+ replace (HsLet (ApiAnn anc (AnnsLet l _i) cs) localDecls expr)
+ =
+ let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls
+ [l2,_l1] = map wrapDecl $ bagToList bagDecls
+ bagDecls' = listToBag $ concatMap decl2Bind [l2]
+ (L (SrcSpanAnn _ le) e) = expr
+ a = (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan le) (MovedAnchor (DP 0 1))) mempty noCom) le)
+ expr' = L a e
+ in (HsLet (ApiAnn anc (AnnsLet l (AD (DP 1 0))) cs) (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
+
+ replace x = x
+-- ---------------------------------------------------------------------
+
+-- | Add a declaration to AddDecl
+changeAddDecl1 :: Changer
+changeAddDecl1 libdir ans top = do
+ Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+ let decl' = setEntryDP' decl (DP 2 0)
+
+ let (p',(_,_),_) = runTransform mempty doAddDecl
+ doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
+ replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
+ replaceTopLevelDecls m = insertAtStart m decl'
+ return (ans,p')
+
+-- ---------------------------------------------------------------------
+changeAddDecl2 :: Changer
+changeAddDecl2 libdir ans top = do
+ Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+ let decl' = setEntryDP' decl (DP 2 0)
+ let top' = anchorEof top
+
+ let (p',(_,_),_) = runTransform mempty doAddDecl
+ doAddDecl = everywhereM (mkM replaceTopLevelDecls) top'
+ replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
+ replaceTopLevelDecls m = insertAtEnd m decl'
+ return (ans,p')
+
+-- ---------------------------------------------------------------------
+changeAddDecl3 :: Changer
+changeAddDecl3 libdir ans top = do
+ Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
+ let decl' = setEntryDP' decl (DP 2 0)
+
+ let (p',(_,_),_) = runTransform mempty doAddDecl
+ doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
+ f d (l1:l2:ls) = l1:d:l2':ls
+ where
+ l2' = setEntryDP' l2 (DP 2 0)
+ replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
+ replaceTopLevelDecls m = insertAt f m decl'
+ return (ans,p')
+
+-- ---------------------------------------------------------------------
+
+-- | Add a local declaration with signature to LocalDecl
+changeLocalDecls :: Changer
+changeLocalDecls libdir ans (L l p) = do
+ Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
+ Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ let decl' = setEntryDP' (L ld decl) (DP 1 0)
+ let sig' = setEntryDP' (L ls sig) (DP 0 0)
+ let (p',(_,_),_w) = runTransform mempty doAddLocal
+ doAddLocal = everywhereM (mkM replaceLocalBinds) p
+ replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
+ -> Transform (LMatch GhcPs (LHsExpr GhcPs))
+ replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ binds sigs))))) = do
+ let oldDecls = sortLocatedA $ map wrapDecl (bagToList binds) ++ map wrapSig sigs
+ let decls = s:d:oldDecls
+ let oldDecls' = captureLineSpacing oldDecls
+ let oldBinds = concatMap decl2Bind oldDecls'
+ (os:oldSigs) = concatMap decl2Sig oldDecls'
+ os' = setEntryDP' os (DP 2 0)
+ let sortKey = captureOrder decls
+ let (ApiAnn anc (AnnList (Just (Anchor anc2 _)) a b c dd) cs) = van
+ let van' = (ApiAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DP 1 4)))) a b c dd) cs)
+ let binds' = (HsValBinds van'
+ (ValBinds sortKey (listToBag $ decl':oldBinds)
+ (sig':os':oldSigs)))
+ return (L lm (Match an mln pats (GRHSs noExtField rhs binds')))
+ replaceLocalBinds x = return x
+ return (ans,L l p')
+
+-- ---------------------------------------------------------------------
+
+-- | Add a local declaration with signature to LocalDecl, where there was no
+-- prior local decl. So it adds a "where" annotation.
+changeLocalDecls2 :: Changer
+changeLocalDecls2 libdir ans (L l p) = do
+ Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
+ let decl' = setEntryDP' (L ld decl) (DP 1 0)
+ let sig' = setEntryDP' (L ls sig) (DP 0 2)
+ let (p',(_,_),_w) = runTransform mempty doAddLocal
+ doAddLocal = everywhereM (mkM replaceLocalBinds) p
+ replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
+ -> Transform (LMatch GhcPs (LHsExpr GhcPs))
+ replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do
+ newSpan <- uniqueSrcSpanT
+ let anc = (Anchor (rs newSpan) (MovedAnchor (DP 1 2)))
+ let anc2 = (Anchor (rs newSpan) (MovedAnchor (DP 1 4)))
+ let an = ApiAnn anc
+ (AnnList (Just anc2) Nothing Nothing
+ [(undeltaSpan (rs newSpan) AnnWhere (DP 0 0))] [])
+ noCom
+ let decls = [s,d]
+ let sortKey = captureOrder decls
+ let binds = (HsValBinds an (ValBinds sortKey (listToBag $ [decl'])
+ [sig']))
+ return (L lm (Match ma mln pats (GRHSs noExtField rhs binds)))
+ replaceLocalBinds x = return x
+ return (ans,L l p')
+
+-- ---------------------------------------------------------------------
+
+-- | Check that balanceCommentsList is idempotent
+changeWhereIn3a :: Changer
+changeWhereIn3a _libdir ans (L l p) = do
+ let decls0 = hsmodDecls p
+ (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
+ (_de0:_:de1:_d2:_) = decls
+ debugM $ unlines w
+ debugM $ "changeWhereIn3a:de1:" ++ showAst de1
+ let p2 = p { hsmodDecls = decls}
+ return (ans,L l p2)
+
+-- ---------------------------------------------------------------------
+
+changeWhereIn3b :: Changer
+changeWhereIn3b _libdir ans (L l p) = do
+ let decls0 = hsmodDecls p
+ (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
+ (de0:_:de1:d2:_) = decls
+ de0' = setEntryDP' de0 (DP 2 0)
+ de1' = setEntryDP' de1 (DP 2 0)
+ d2' = setEntryDP' d2 (DP 2 0)
+ decls' = d2':de1':de0':(tail decls)
+ debugM $ unlines w
+ debugM $ "changeWhereIn3b:de1':" ++ showAst de1'
+ let p2 = p { hsmodDecls = decls'}
+ return (ans,L l p2)
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl1 :: Changer
+addLocaLDecl1 libdir ans lp = do
+ Right (_, (L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ let decl' = setEntryDP' (L ld decl) (DP 1 4)
+ doAddLocal = do
+ (de1:d2:d3:_) <- hsDecls lp
+ (de1'',d2') <- balanceComments de1 d2
+ (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do
+ return ((wrapDecl decl' : d),Nothing)
+ replaceDecls lp [de1', d2', d3]
+
+ (lp',(_,_),w) <- runTransformT mempty doAddLocal
+ debugM $ "addLocaLDecl1:" ++ intercalate "\n" w
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl2 :: Changer
+addLocaLDecl2 libdir ans lp = do
+ Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ let
+ doAddLocal = do
+ (de1:d2:_) <- hsDecls lp
+ (de1'',d2') <- balanceComments de1 d2
+
+ (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do
+ newDecl' <- transferEntryDP' d newDecl
+ let d' = setEntryDP' d (DP 1 0)
+ return ((newDecl':d':ds),Nothing)
+
+ replaceDecls lp [parent',d2']
+
+ (lp',(_,_),_w) <- runTransformT mempty doAddLocal
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl3 :: Changer
+addLocaLDecl3 libdir ans lp = do
+ Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ -- Right (_, newDecl@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "jj = 2")
+ let
+ doAddLocal = do
+ (de1:d2:_) <- hsDecls lp
+ (de1'',d2') <- balanceComments de1 d2
+
+ (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do
+ let newDecl' = setEntryDP' newDecl (DP 1 0)
+ return (((d:ds) ++ [newDecl']),Nothing)
+
+ replaceDecls (anchorEof lp) [parent',d2']
+
+ (lp',(_,_),_w) <- runTransformT mempty doAddLocal
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl4 :: Changer
+addLocaLDecl4 libdir ans lp = do
+ Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
+ Right (_, newSig) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
+ -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp
+ let
+ doAddLocal = do
+ (parent:ds) <- hsDecls lp
+
+ let newDecl' = setEntryDP' newDecl (DP 1 0)
+ let newSig' = setEntryDP' newSig (DP 1 4)
+
+ (parent',_) <- modifyValD (getLocA parent) parent $ \_m decls -> do
+ return ((decls++[newSig',newDecl']),Nothing)
+
+ replaceDecls (anchorEof lp) (parent':ds)
+
+ (lp',(_,_),_w) <- runTransformT mempty doAddLocal
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl5 :: Changer
+addLocaLDecl5 _libdir ans lp = do
+ let
+ doAddLocal = do
+ decls <- hsDecls lp
+ [s1,de1,d2,d3] <- balanceCommentsList decls
+
+ let d3' = setEntryDP' d3 (DP 2 0)
+
+ (de1',_) <- modifyValD (getLocA de1) de1 $ \_m _decls -> do
+ let d2' = setEntryDP' d2 (DP 1 0)
+ return ([d2'],Nothing)
+ replaceDecls lp [s1,de1',d3']
+
+ (lp',(_,_),_w) <- runTransformT mempty doAddLocal
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addLocaLDecl6 :: Changer
+addLocaLDecl6 libdir ans lp = do
+ Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")
+ let
+ newDecl' = setEntryDP' newDecl (DP 1 4)
+ doAddLocal = do
+ decls0 <- hsDecls lp
+ [de1'',d2] <- balanceCommentsList decls0
+
+ let de1 = captureMatchLineSpacing de1''
+ let L _ (ValD _ (FunBind _ _ (MG _ (L _ ms) _) _)) = de1
+ let [ma1,_ma2] = ms
+
+ (de1',_) <- modifyValD (getLocA ma1) de1 $ \_m decls -> do
+ return ((newDecl' : decls),Nothing)
+ replaceDecls lp [de1', d2]
+
+ (lp',(_,_),_w) <- runTransformT mempty doAddLocal
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl1 :: Changer
+rmDecl1 _libdir ans lp = do
+ let doRmDecl = do
+ tlDecs0 <- hsDecls lp
+ tlDecs <- balanceCommentsList $ captureLineSpacing tlDecs0
+ let (de1:_s1:_d2:ds) = tlDecs
+
+ replaceDecls lp (de1:ds)
+
+ (lp',(_,_),_w) <- runTransformT mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl2 :: Changer
+rmDecl2 _libdir ans lp = do
+ let
+ doRmDecl = do
+ let
+ go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)
+ go e@(GHC.L _ (GHC.HsLet{})) = do
+ decs0 <- hsDecls e
+ decs <- balanceCommentsList $ captureLineSpacing decs0
+ e' <- replaceDecls e (init decs)
+ return e'
+ go x = return x
+
+ everywhereM (mkM go) lp
+
+ let (lp',(_,_),_w) = runTransform mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl3 :: Changer
+rmDecl3 _libdir ans lp = do
+ let
+ doRmDecl = do
+ [de1,d2] <- hsDecls lp
+
+ (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1] -> do
+ let sd1' = setEntryDP' sd1 (DP 2 0)
+ return ([],Just sd1')
+
+ replaceDecls lp [de1',sd1,d2]
+
+ (lp',(_,_),_w) <- runTransformT mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl4 :: Changer
+rmDecl4 _libdir ans lp = do
+ let
+ doRmDecl = do
+ [de1] <- hsDecls lp
+
+ (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do
+ sd2' <- transferEntryDP' sd1 sd2
+
+ let sd1' = setEntryDP' sd1 (DP 2 0)
+ return ([sd2'],Just sd1')
+
+ replaceDecls (anchorEof lp) [de1',sd1]
+
+ (lp',(_,_),_w) <- runTransformT mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl5 :: Changer
+rmDecl5 _libdir ans lp = do
+ let
+ doRmDecl = do
+ let
+ go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
+ go (HsLet a lb expr) = do
+ decs <- hsDeclsValBinds lb
+ let dec = last decs
+ _ <- transferEntryDPT (head decs) dec
+ lb' <- replaceDeclsValbinds WithoutWhere lb [dec]
+ return (HsLet a lb' expr)
+ go x = return x
+
+ everywhereM (mkM go) lp
+
+ let (lp',(_,_),_w) = runTransform mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl6 :: Changer
+rmDecl6 _libdir ans lp = do
+ let
+ doRmDecl = do
+ [de1] <- hsDecls lp
+
+ (de1',_) <- modifyValD (getLocA de1) de1 $ \_m subDecs -> do
+ let (ss1:_sd1:sd2:sds) = subDecs
+ sd2' <- transferEntryDP' ss1 sd2
+
+ return (sd2':sds,Nothing)
+
+ replaceDecls lp [de1']
+
+ (lp',(_,_),_w) <- runTransformT mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmDecl7 :: Changer
+rmDecl7 _libdir ans lp = do
+ let
+ doRmDecl = do
+ tlDecs <- hsDecls lp
+ [s1,de1,d2,d3] <- balanceCommentsList tlDecs
+
+ d3' <- transferEntryDP' d2 d3
+
+ replaceDecls lp [s1,de1,d3']
+
+ (lp',(_,_),_w) <- runTransformT mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmTypeSig1 :: Changer
+rmTypeSig1 _libdir ans lp = do
+ let doRmDecl = do
+ tlDecs <- hsDecls lp
+ let (s0:de1:d2) = tlDecs
+ s1 = captureTypeSigSpacing s0
+ (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1
+ n2' <- transferEntryDP n1 n2
+ let s1' = (L l (SigD x1 (TypeSig x2 [n2'] typ)))
+ replaceDecls lp (s1':de1:d2)
+
+ let (lp',(_,_),_w) = runTransform mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+rmTypeSig2 :: Changer
+rmTypeSig2 _libdir ans lp = do
+ let doRmDecl = do
+ tlDecs <- hsDecls lp
+ let [de1] = tlDecs
+
+ (de1',_) <- modifyValD (getLocA de1) de1 $ \_m [s,d] -> do
+ d' <- transferEntryDPT s d
+ return ([d'],Nothing)
+ replaceDecls lp [de1']
+
+ let (lp',(_,_),_w) = runTransform mempty doRmDecl
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding1 :: Changer
+addHiding1 _libdir ans (L l p) = do
+ let doTransform = do
+ l0 <- uniqueSrcSpanT
+ l1 <- uniqueSrcSpanT
+ l2 <- uniqueSrcSpanT
+ let
+ [L li imp1,imp2] = hsmodImports p
+ n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))
+ n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))
+ v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1)))
+ v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2)))
+ impHiding = L (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan l0) m0)
+ (AnnList Nothing
+ (Just (AddApiAnn AnnOpenP d1))
+ (Just (AddApiAnn AnnCloseP d0))
+ [(AddApiAnn AnnHiding d1)]
+ [])
+ noCom) l0) [v1,v2]
+ imp1' = imp1 { ideclHiding = Just (True,impHiding)}
+ p' = p { hsmodImports = [L li imp1',imp2]}
+ return (L l p')
+
+ let (lp',(_ans',_),_w) = runTransform mempty doTransform
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+-- ---------------------------------------------------------------------
+
+addHiding2 :: Changer
+addHiding2 _libdir ans (L l p) = do
+ let doTransform = do
+ l1 <- uniqueSrcSpanT
+ l2 <- uniqueSrcSpanT
+ let
+ [L li imp1] = hsmodImports p
+ Just (_,L lh ns) = ideclHiding imp1
+ lh' = (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan (locA lh)) m0)
+ (AnnList Nothing
+ (Just (AddApiAnn AnnOpenP d1))
+ (Just (AddApiAnn AnnCloseP d0))
+ [(AddApiAnn AnnHiding d1)]
+ [])
+ noCom) (locA lh))
+ n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))
+ n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))
+ v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1)))
+ v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2)))
+ L ln n = last ns
+ n' = L (addComma ln) n
+ imp1' = imp1 { ideclHiding = Just (True,L lh' (init ns ++ [n',v1,v2]))}
+ p' = p { hsmodImports = [L li imp1']}
+ return (L l p')
+
+ let (lp',(_ans',_),_w) = runTransform mempty doTransform
+ debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
+ return (ans,lp')
+
+
+-- ---------------------------------------------------------------------
+-- From SYB
+
+-- | Apply transformation on each level of a tree.
+--
+-- Just like 'everything', this is stolen from SYB package.
+everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a)
+everywhere f = f . gmapT (everywhere f)
+
+-- | Create generic transformation.
+--
+-- Another function stolen from SYB package.
+mkT :: (Typeable a, Typeable b) => (b -> b) -> (a -> a)
+mkT f = case cast f of
+ Just f' -> f'
+ Nothing -> id
+
+-- ---------------------------------------------------------------------
diff --git a/utils/check-exact/Test.hs b/utils/check-exact/Test.hs
deleted file mode 100644
index 57c09cc737..0000000000
--- a/utils/check-exact/Test.hs
+++ /dev/null
@@ -1,840 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
-
-import Data.List
-import Data.Data
-import GHC.Types.Name.Occurrence
-import GHC.Types.Name.Reader
-import GHC hiding (moduleName)
-import GHC.Driver.Ppr
-import GHC.Driver.Session
-import GHC.Hs.Dump
-import GHC.Data.Bag
-import System.Environment( getArgs )
-import System.Exit
-import System.FilePath
-
-import Types
-import Utils
-import ExactPrint
-import Transform
-import Parsers
-
-import GHC.Parser.Lexer
-import GHC.Data.FastString
-import GHC.Types.SrcLoc
-
--- ---------------------------------------------------------------------
-
-_tt :: IO ()
--- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/ghc/_build/stage1/lib"
-_tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprint/_build/stage1/lib"
--- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_build/stage1/lib"
- "cases/RenameCase1.hs" changeRenameCase1
- -- "cases/LayoutLet2.hs" changeLayoutLet2
- -- "cases/LayoutLet3.hs" changeLayoutLet3
- -- "cases/LayoutLet4.hs" changeLayoutLet3
- -- "cases/Rename1.hs" changeRename1
- -- "cases/Rename2.hs" changeRename2
- -- "cases/LayoutIn1.hs" changeLayoutIn1
- -- "cases/LayoutIn3.hs" changeLayoutIn3
- -- "cases/LayoutIn3a.hs" changeLayoutIn3
- -- "cases/LayoutIn3b.hs" changeLayoutIn3
- -- "cases/LayoutIn4.hs" changeLayoutIn4
- -- "cases/LocToName.hs" changeLocToName
- -- "cases/LetIn1.hs" changeLetIn1
- -- "cases/WhereIn4.hs" changeWhereIn4
- -- "cases/AddDecl1.hs" changeAddDecl1
- -- "cases/AddDecl2.hs" changeAddDecl2
- -- "cases/AddDecl3.hs" changeAddDecl3
- -- "cases/LocalDecls.hs" changeLocalDecls
- -- "cases/LocalDecls2.hs" changeLocalDecls2
- -- "cases/WhereIn3a.hs" changeWhereIn3a
- -- "cases/WhereIn3b.hs" changeWhereIn3b
- -- "cases/AddLocalDecl1.hs" addLocaLDecl1
- -- "cases/AddLocalDecl2.hs" addLocaLDecl2
- -- "cases/AddLocalDecl3.hs" addLocaLDecl3
- -- "cases/AddLocalDecl4.hs" addLocaLDecl4
- -- "cases/AddLocalDecl5.hs" addLocaLDecl5
- -- "cases/AddLocalDecl6.hs" addLocaLDecl6
- -- "cases/RmDecl1.hs" rmDecl1
- -- "cases/RmDecl2.hs" rmDecl2
- -- "cases/RmDecl3.hs" rmDecl3
- -- "cases/RmDecl4.hs" rmDecl4
- -- "cases/RmDecl5.hs" rmDecl5
- -- "cases/RmDecl6.hs" rmDecl6
- -- "cases/RmDecl7.hs" rmDecl7
- -- "cases/RmTypeSig1.hs" rmTypeSig1
- -- "cases/RmTypeSig2.hs" rmTypeSig2
- -- "cases/AddHiding1.hs" addHiding1
- -- "cases/AddHiding2.hs" addHiding2
-
--- cloneT does not need a test, function can be retired
-
-
--- exact = ppr
-
-changers :: [(String, Changer)]
-changers =
- [("noChange", noChange)
- ,("changeRenameCase1", changeRenameCase1)
- ,("changeLayoutLet2", changeLayoutLet2)
- ,("changeLayoutLet3", changeLayoutLet3)
- ,("changeLayoutIn1", changeLayoutIn1)
- ,("changeLayoutIn3", changeLayoutIn3)
- ,("changeLayoutIn4", changeLayoutIn4)
- ,("changeLocToName", changeLocToName)
- ,("changeRename1", changeRename1)
- ,("changeRename2", changeRename2)
- ,("changeWhereIn4", changeWhereIn4)
- ,("changeLetIn1", changeLetIn1)
- ,("changeAddDecl1", changeAddDecl1)
- ,("changeAddDecl2", changeAddDecl2)
- ,("changeAddDecl3", changeAddDecl3)
- ,("changeLocalDecls", changeLocalDecls)
- ,("changeLocalDecls2", changeLocalDecls2)
- ,("changeWhereIn3a", changeWhereIn3a)
- ,("changeWhereIn3b", changeWhereIn3b)
- ,("addLocaLDecl1", addLocaLDecl1)
- ,("addLocaLDecl2", addLocaLDecl2)
- ,("addLocaLDecl3", addLocaLDecl3)
- ,("addLocaLDecl4", addLocaLDecl4)
- ,("addLocaLDecl5", addLocaLDecl5)
- ,("addLocaLDecl6", addLocaLDecl6)
- ,("rmDecl1", rmDecl1)
- ,("rmDecl2", rmDecl2)
- ,("rmDecl3", rmDecl3)
- ,("rmDecl4", rmDecl4)
- ,("rmDecl5", rmDecl5)
- ,("rmDecl6", rmDecl6)
- ,("rmDecl7", rmDecl7)
- ,("rmTypeSig1", rmTypeSig1)
- ,("rmTypeSig2", rmTypeSig2)
- ,("addHiding1", addHiding1)
- ,("addHiding2", addHiding2)
- ,("addHiding2", addHiding2)
- ]
-
--- ---------------------------------------------------------------------
-
-usage :: String
-usage = unlines
- [ "usage: check-ppr (libdir) (file)"
- , ""
- , "where libdir is the GHC library directory (e.g. the output of"
- , "ghc --print-libdir) and file is the file to parse."
- ]
-
-main :: IO()
-main = do
- args <- getArgs
- case args of
- [libdir,fileName] -> testOneFile changers libdir fileName noChange
- _ -> putStrLn usage
-
-deriving instance Data Token
-deriving instance Data PsSpan
-deriving instance Data BufSpan
-deriving instance Data BufPos
-
-testOneFile :: [(String, Changer)] -> FilePath -> String -> Changer -> IO ()
-testOneFile _ libdir fileName changer = do
- (p,_toks) <- parseOneFile libdir fileName
- -- putStrLn $ "\n\ngot p" ++ showAst (take 4 $ reverse toks)
- let
- origAst = ppAst (pm_parsed_source p)
- anns' = pm_annotations p
- -- pped = pragmas ++ "\n" ++ (exactPrint $ pm_parsed_source p)
- pped = exactPrint (pm_parsed_source p) anns'
- -- pragmas = getPragmas anns'
-
- newFile = dropExtension fileName <.> "ppr" <.> takeExtension fileName
- newFileChanged = dropExtension fileName <.> "changed" <.> takeExtension fileName
- newFileExpected = dropExtension fileName <.> "expected" <.> takeExtension fileName
- astFile = fileName <.> "ast"
- newAstFile = fileName <.> "ast.new"
- changedAstFile = fileName <.> "ast.changed"
-
- -- pped' <- exactprintWithChange changeRenameCase1 (pm_parsed_source p) anns'
- (pped', ast') <- exactprintWithChange libdir changer (pm_parsed_source p) anns'
- -- putStrLn $ "\n\nabout to writeFile"
- writeFile changedAstFile (ppAst ast')
- writeFile astFile origAst
- -- putStrLn $ "\n\nabout to pp"
- writeFile newFile pped
- writeFile newFileChanged pped'
-
- -- putStrLn $ "anns':" ++ showPprUnsafe (apiAnnRogueComments anns')
-
- (p',_) <- parseOneFile libdir newFile
-
- let newAstStr :: String
- newAstStr = ppAst (pm_parsed_source p')
- writeFile newAstFile newAstStr
- expectedSource <- readFile newFileExpected
- changedSource <- readFile newFileChanged
-
- -- putStrLn $ "\n\nanns':" ++ showPprUnsafe (apiAnnRogueComments anns')
-
- let
- origAstOk = origAst == newAstStr
- changedSourceOk = expectedSource == changedSource
- if origAstOk && changedSourceOk
- then do
- -- putStrLn "ASTs matched"
- exitSuccess
- else if not origAstOk
- then do
- putStrLn "AST Match Failed"
- -- putStrLn "\n===================================\nOrig\n\n"
- -- putStrLn origAst
- putStrLn "\n===================================\nNew\n\n"
- putStrLn newAstStr
- exitFailure
- else do
- putStrLn "Changed AST Source Mismatch"
- putStrLn "\n===================================\nExpected\n\n"
- putStrLn expectedSource
- putStrLn "\n===================================\nChanged\n\n"
- putStrLn changedSource
- putStrLn "\n===================================\n"
- putStrLn $ show changedSourceOk
- exitFailure
-
-ppAst :: Data a => a -> String
-ppAst ast = showSDocUnsafe $ showAstData BlankSrcSpanFile NoBlankApiAnnotations ast
-
-parseOneFile :: FilePath -> FilePath -> IO (ParsedModule, [Located Token])
-parseOneFile libdir fileName = do
- let modByFile m =
- case ml_hs_file $ ms_location m of
- Nothing -> False
- Just fn -> fn == fileName
- runGhc (Just libdir) $ do
- dflags <- getSessionDynFlags
- let dflags2 = dflags `gopt_set` Opt_KeepRawTokenStream
- _ <- setSessionDynFlags dflags2
- addTarget Target { targetId = TargetFile fileName Nothing
- , targetAllowObjCode = True
- , targetContents = Nothing }
- _ <- load LoadAllTargets
- graph <- getModuleGraph
- let
- modSum = case filter modByFile (mgModSummaries graph) of
- [x] -> x
- xs -> error $ "Can't find module, got:"
- ++ show (map (ml_hs_file . ms_location) xs)
- pm <- GHC.parseModule modSum
- toks <- getTokenStream (ms_mod modSum)
- return (pm, toks)
-
- -- getTokenStream :: GhcMonad m => Module -> m [Located Token]
-
--- getPragmas :: ApiAnns -> String
--- getPragmas anns' = pragmaStr
--- where
--- tokComment (L _ (AnnBlockComment s)) = s
--- tokComment (L _ (AnnLineComment s)) = s
--- tokComment _ = ""
-
--- comments' = map tokComment $ sortRealLocated $ apiAnnRogueComments anns'
--- pragmas = filter (\c -> isPrefixOf "{-#" c ) comments'
--- pragmaStr = intercalate "\n" pragmas
-
--- pp :: (Outputable a) => a -> String
--- pp a = showPpr unsafeGlobalDynFlags a
-
--- ---------------------------------------------------------------------
-
-exactprintWithChange :: FilePath -> Changer -> ParsedSource -> ApiAnns -> IO (String, ParsedSource)
-exactprintWithChange libdir f p anns = do
- debugM $ "exactprintWithChange:anns=" ++ showGhc (apiAnnRogueComments anns)
- (anns',p') <- f libdir anns p
- return (exactPrint p' anns', p')
-
-
--- First param is libdir
-type Changer = FilePath -> (ApiAnns -> ParsedSource -> IO (ApiAnns,ParsedSource))
-
-noChange :: Changer
-noChange _libdir ans parsed = return (ans,parsed)
-
-changeRenameCase1 :: Changer
-changeRenameCase1 _libdir ans parsed = return (ans,rename "bazLonger" [((3,15),(3,18))] parsed)
-
-changeLayoutLet2 :: Changer
-changeLayoutLet2 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)
-
-changeLayoutLet3 :: Changer
-changeLayoutLet3 _libdir ans parsed = return (ans,rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
-
-changeLayoutIn1 :: Changer
-changeLayoutIn1 _libdir ans parsed = return (ans,rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)
-
-changeLayoutIn3 :: Changer
-changeLayoutIn3 _libdir ans parsed = return (ans,rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
-
-changeLayoutIn4 :: Changer
-changeLayoutIn4 _libdir ans parsed = return (ans,rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)
-
-changeLocToName :: Changer
-changeLocToName _libdir ans parsed = return (ans,rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)
-
-
-changeRename1 :: Changer
-changeRename1 _libdir ans parsed = return (ans,rename "bar2" [((3,1),(3,4))] parsed)
-
-changeRename2 :: Changer
-changeRename2 _libdir ans parsed = return (ans,rename "joe" [((2,1),(2,5))] parsed)
-
-rename :: (Data a) => String -> [(Pos, Pos)] -> a -> a
-rename newNameStr spans' a
- = everywhere (mkT replaceRdr) a
- where
- newName = mkRdrUnqual (mkVarOcc newNameStr)
-
- cond :: SrcSpan -> Bool
- cond ln = ss2range ln `elem` spans'
-
- replaceRdr :: LocatedN RdrName -> LocatedN RdrName
- replaceRdr (L ln _)
- | cond (locA ln) = L ln newName
- replaceRdr x = x
-
--- ---------------------------------------------------------------------
-
-changeWhereIn4 :: Changer
-changeWhereIn4 _libdir ans parsed
- = return (ans,everywhere (mkT replace) parsed)
- where
- replace :: LocatedN RdrName -> LocatedN RdrName
- replace (L ln _n)
- | ss2range (locA ln) == ((12,16),(12,17)) = L ln (mkRdrUnqual (mkVarOcc "p_2"))
- replace x = x
-
--- ---------------------------------------------------------------------
-
-changeLetIn1 :: Changer
-changeLetIn1 _libdir ans parsed
- = return (ans,everywhere (mkT replace) parsed)
- where
- replace :: HsExpr GhcPs -> HsExpr GhcPs
- replace (HsLet (ApiAnn anc (AnnsLet l _i) cs) localDecls expr)
- =
- let (HsValBinds x (ValBinds xv bagDecls sigs)) = localDecls
- [l2,_l1] = map wrapDecl $ bagToList bagDecls
- bagDecls' = listToBag $ concatMap decl2Bind [l2]
- (L (SrcSpanAnn _ le) e) = expr
- a = (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan le) (MovedAnchor (DP 0 1))) mempty noCom) le)
- expr' = L a e
- in (HsLet (ApiAnn anc (AnnsLet l (AD (DP 1 0))) cs) (HsValBinds x (ValBinds xv bagDecls' sigs)) expr')
-
- replace x = x
--- ---------------------------------------------------------------------
-
--- | Add a declaration to AddDecl
-changeAddDecl1 :: Changer
-changeAddDecl1 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
- let decl' = setEntryDP' decl (DP 2 0)
-
- let (p',(_,_),_) = runTransform mempty doAddDecl
- doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
- replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
- replaceTopLevelDecls m = insertAtStart m decl'
- return (ans,p')
-
--- ---------------------------------------------------------------------
-changeAddDecl2 :: Changer
-changeAddDecl2 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
- let decl' = setEntryDP' decl (DP 2 0)
- let top' = anchorEof top
-
- let (p',(_,_),_) = runTransform mempty doAddDecl
- doAddDecl = everywhereM (mkM replaceTopLevelDecls) top'
- replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
- replaceTopLevelDecls m = insertAtEnd m decl'
- return (ans,p')
-
--- ---------------------------------------------------------------------
-changeAddDecl3 :: Changer
-changeAddDecl3 libdir ans top = do
- Right (_, decl) <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
- let decl' = setEntryDP' decl (DP 2 0)
-
- let (p',(_,_),_) = runTransform mempty doAddDecl
- doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
- f d (l1:l2:ls) = l1:d:l2':ls
- where
- l2' = setEntryDP' l2 (DP 2 0)
- replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
- replaceTopLevelDecls m = insertAt f m decl'
- return (ans,p')
-
--- ---------------------------------------------------------------------
-
--- | Add a local declaration with signature to LocalDecl
-changeLocalDecls :: Changer
-changeLocalDecls libdir ans (L l p) = do
- Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
- Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- let decl' = setEntryDP' (L ld decl) (DP 1 0)
- let sig' = setEntryDP' (L ls sig) (DP 0 0)
- let (p',(_,_),_w) = runTransform mempty doAddLocal
- doAddLocal = everywhereM (mkM replaceLocalBinds) p
- replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
- -> Transform (LMatch GhcPs (LHsExpr GhcPs))
- replaceLocalBinds (L lm (Match an mln pats (GRHSs _ rhs (HsValBinds van (ValBinds _ binds sigs))))) = do
- let oldDecls = sortLocatedA $ map wrapDecl (bagToList binds) ++ map wrapSig sigs
- let decls = s:d:oldDecls
- let oldDecls' = captureLineSpacing oldDecls
- let oldBinds = concatMap decl2Bind oldDecls'
- (os:oldSigs) = concatMap decl2Sig oldDecls'
- os' = setEntryDP' os (DP 2 0)
- let sortKey = captureOrder decls
- let (ApiAnn anc (AnnList (Just (Anchor anc2 _)) a b c dd) cs) = van
- let van' = (ApiAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DP 1 4)))) a b c dd) cs)
- let binds' = (HsValBinds van'
- (ValBinds sortKey (listToBag $ decl':oldBinds)
- (sig':os':oldSigs)))
- return (L lm (Match an mln pats (GRHSs noExtField rhs binds')))
- replaceLocalBinds x = return x
- return (ans,L l p')
-
--- ---------------------------------------------------------------------
-
--- | Add a local declaration with signature to LocalDecl, where there was no
--- prior local decl. So it adds a "where" annotation.
-changeLocalDecls2 :: Changer
-changeLocalDecls2 libdir ans (L l p) = do
- Right (_, d@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- Right (_, s@(L ls (SigD _ sig))) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
- let decl' = setEntryDP' (L ld decl) (DP 1 0)
- let sig' = setEntryDP' (L ls sig) (DP 0 2)
- let (p',(_,_),_w) = runTransform mempty doAddLocal
- doAddLocal = everywhereM (mkM replaceLocalBinds) p
- replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs)
- -> Transform (LMatch GhcPs (LHsExpr GhcPs))
- replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do
- newSpan <- uniqueSrcSpanT
- let anc = (Anchor (rs newSpan) (MovedAnchor (DP 1 2)))
- let anc2 = (Anchor (rs newSpan) (MovedAnchor (DP 1 4)))
- let an = ApiAnn anc
- (AnnList (Just anc2) Nothing Nothing
- [(undeltaSpan (rs newSpan) AnnWhere (DP 0 0))] [])
- noCom
- let decls = [s,d]
- let sortKey = captureOrder decls
- let binds = (HsValBinds an (ValBinds sortKey (listToBag $ [decl'])
- [sig']))
- return (L lm (Match ma mln pats (GRHSs noExtField rhs binds)))
- replaceLocalBinds x = return x
- return (ans,L l p')
-
--- ---------------------------------------------------------------------
-
--- | Check that balanceCommentsList is idempotent
-changeWhereIn3a :: Changer
-changeWhereIn3a _libdir ans (L l p) = do
- let decls0 = hsmodDecls p
- (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
- (_de0:_:de1:_d2:_) = decls
- debugM $ unlines w
- debugM $ "changeWhereIn3a:de1:" ++ showAst de1
- let p2 = p { hsmodDecls = decls}
- return (ans,L l p2)
-
--- ---------------------------------------------------------------------
-
-changeWhereIn3b :: Changer
-changeWhereIn3b _libdir ans (L l p) = do
- let decls0 = hsmodDecls p
- (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0)
- (de0:_:de1:d2:_) = decls
- de0' = setEntryDP' de0 (DP 2 0)
- de1' = setEntryDP' de1 (DP 2 0)
- d2' = setEntryDP' d2 (DP 2 0)
- decls' = d2':de1':de0':(tail decls)
- debugM $ unlines w
- debugM $ "changeWhereIn3b:de1':" ++ showAst de1'
- let p2 = p { hsmodDecls = decls'}
- return (ans,L l p2)
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl1 :: Changer
-addLocaLDecl1 libdir ans lp = do
- Right (_, (L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- let decl' = setEntryDP' (L ld decl) (DP 1 4)
- doAddLocal = do
- (de1:d2:d3:_) <- hsDecls lp
- (de1'',d2') <- balanceComments de1 d2
- (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do
- return ((wrapDecl decl' : d),Nothing)
- replaceDecls lp [de1', d2', d3]
-
- (lp',(_,_),w) <- runTransformT mempty doAddLocal
- debugM $ "addLocaLDecl1:" ++ intercalate "\n" w
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl2 :: Changer
-addLocaLDecl2 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- let
- doAddLocal = do
- (de1:d2:_) <- hsDecls lp
- (de1'',d2') <- balanceComments de1 d2
-
- (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do
- newDecl' <- transferEntryDP' d newDecl
- let d' = setEntryDP' d (DP 1 0)
- return ((newDecl':d':ds),Nothing)
-
- replaceDecls lp [parent',d2']
-
- (lp',(_,_),_w) <- runTransformT mempty doAddLocal
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl3 :: Changer
-addLocaLDecl3 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- -- Right (_, newDecl@(L ld (ValD _ decl))) <- withDynFlags libdir (\df -> parseDecl df "decl" "jj = 2")
- let
- doAddLocal = do
- (de1:d2:_) <- hsDecls lp
- (de1'',d2') <- balanceComments de1 d2
-
- (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do
- let newDecl' = setEntryDP' newDecl (DP 1 0)
- return (((d:ds) ++ [newDecl']),Nothing)
-
- replaceDecls (anchorEof lp) [parent',d2']
-
- (lp',(_,_),_w) <- runTransformT mempty doAddLocal
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl4 :: Changer
-addLocaLDecl4 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
- Right (_, newSig) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int")
- -- putStrLn $ "addLocaLDecl4:lp=" ++ showGhc lp
- let
- doAddLocal = do
- (parent:ds) <- hsDecls lp
-
- let newDecl' = setEntryDP' newDecl (DP 1 0)
- let newSig' = setEntryDP' newSig (DP 1 4)
-
- (parent',_) <- modifyValD (getLocA parent) parent $ \_m decls -> do
- return ((decls++[newSig',newDecl']),Nothing)
-
- replaceDecls (anchorEof lp) (parent':ds)
-
- (lp',(_,_),_w) <- runTransformT mempty doAddLocal
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl5 :: Changer
-addLocaLDecl5 _libdir ans lp = do
- let
- doAddLocal = do
- decls <- hsDecls lp
- [s1,de1,d2,d3] <- balanceCommentsList decls
-
- let d3' = setEntryDP' d3 (DP 2 0)
-
- (de1',_) <- modifyValD (getLocA de1) de1 $ \_m _decls -> do
- let d2' = setEntryDP' d2 (DP 1 0)
- return ([d2'],Nothing)
- replaceDecls lp [s1,de1',d3']
-
- (lp',(_,_),_w) <- runTransformT mempty doAddLocal
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addLocaLDecl6 :: Changer
-addLocaLDecl6 libdir ans lp = do
- Right (_, newDecl) <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")
- let
- newDecl' = setEntryDP' newDecl (DP 1 4)
- doAddLocal = do
- decls0 <- hsDecls lp
- [de1'',d2] <- balanceCommentsList decls0
-
- let de1 = captureMatchLineSpacing de1''
- let L _ (ValD _ (FunBind _ _ (MG _ (L _ ms) _) _)) = de1
- let [ma1,_ma2] = ms
-
- (de1',_) <- modifyValD (getLocA ma1) de1 $ \_m decls -> do
- return ((newDecl' : decls),Nothing)
- replaceDecls lp [de1', d2]
-
- (lp',(_,_),_w) <- runTransformT mempty doAddLocal
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl1 :: Changer
-rmDecl1 _libdir ans lp = do
- let doRmDecl = do
- tlDecs0 <- hsDecls lp
- tlDecs <- balanceCommentsList $ captureLineSpacing tlDecs0
- let (de1:_s1:_d2:ds) = tlDecs
-
- replaceDecls lp (de1:ds)
-
- (lp',(_,_),_w) <- runTransformT mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl2 :: Changer
-rmDecl2 _libdir ans lp = do
- let
- doRmDecl = do
- let
- go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)
- go e@(GHC.L _ (GHC.HsLet{})) = do
- decs0 <- hsDecls e
- decs <- balanceCommentsList $ captureLineSpacing decs0
- e' <- replaceDecls e (init decs)
- return e'
- go x = return x
-
- everywhereM (mkM go) lp
-
- let (lp',(_,_),_w) = runTransform mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl3 :: Changer
-rmDecl3 _libdir ans lp = do
- let
- doRmDecl = do
- [de1,d2] <- hsDecls lp
-
- (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1] -> do
- let sd1' = setEntryDP' sd1 (DP 2 0)
- return ([],Just sd1')
-
- replaceDecls lp [de1',sd1,d2]
-
- (lp',(_,_),_w) <- runTransformT mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl4 :: Changer
-rmDecl4 _libdir ans lp = do
- let
- doRmDecl = do
- [de1] <- hsDecls lp
-
- (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do
- sd2' <- transferEntryDP' sd1 sd2
-
- let sd1' = setEntryDP' sd1 (DP 2 0)
- return ([sd2'],Just sd1')
-
- replaceDecls (anchorEof lp) [de1',sd1]
-
- (lp',(_,_),_w) <- runTransformT mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl5 :: Changer
-rmDecl5 _libdir ans lp = do
- let
- doRmDecl = do
- let
- go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
- go (HsLet a lb expr) = do
- decs <- hsDeclsValBinds lb
- let dec = last decs
- _ <- transferEntryDPT (head decs) dec
- lb' <- replaceDeclsValbinds WithoutWhere lb [dec]
- return (HsLet a lb' expr)
- go x = return x
-
- everywhereM (mkM go) lp
-
- let (lp',(_,_),_w) = runTransform mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl6 :: Changer
-rmDecl6 _libdir ans lp = do
- let
- doRmDecl = do
- [de1] <- hsDecls lp
-
- (de1',_) <- modifyValD (getLocA de1) de1 $ \_m subDecs -> do
- let (ss1:_sd1:sd2:sds) = subDecs
- sd2' <- transferEntryDP' ss1 sd2
-
- return (sd2':sds,Nothing)
-
- replaceDecls lp [de1']
-
- (lp',(_,_),_w) <- runTransformT mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmDecl7 :: Changer
-rmDecl7 _libdir ans lp = do
- let
- doRmDecl = do
- tlDecs <- hsDecls lp
- [s1,de1,d2,d3] <- balanceCommentsList tlDecs
-
- d3' <- transferEntryDP' d2 d3
-
- replaceDecls lp [s1,de1,d3']
-
- (lp',(_,_),_w) <- runTransformT mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmTypeSig1 :: Changer
-rmTypeSig1 _libdir ans lp = do
- let doRmDecl = do
- tlDecs <- hsDecls lp
- let (s0:de1:d2) = tlDecs
- s1 = captureTypeSigSpacing s0
- (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1
- n2' <- transferEntryDP n1 n2
- let s1' = (L l (SigD x1 (TypeSig x2 [n2'] typ)))
- replaceDecls lp (s1':de1:d2)
-
- let (lp',(_,_),_w) = runTransform mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-rmTypeSig2 :: Changer
-rmTypeSig2 _libdir ans lp = do
- let doRmDecl = do
- tlDecs <- hsDecls lp
- let [de1] = tlDecs
-
- (de1',_) <- modifyValD (getLocA de1) de1 $ \_m [s,d] -> do
- d' <- transferEntryDPT s d
- return ([d'],Nothing)
- replaceDecls lp [de1']
-
- let (lp',(_,_),_w) = runTransform mempty doRmDecl
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addHiding1 :: Changer
-addHiding1 _libdir ans (L l p) = do
- let doTransform = do
- l0 <- uniqueSrcSpanT
- l1 <- uniqueSrcSpanT
- l2 <- uniqueSrcSpanT
- let
- [L li imp1,imp2] = hsmodImports p
- n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))
- n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))
- v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1)))
- v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2)))
- impHiding = L (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan l0) m0)
- (AnnList Nothing
- (Just (AddApiAnn AnnOpenP d1))
- (Just (AddApiAnn AnnCloseP d0))
- [(AddApiAnn AnnHiding d1)]
- [])
- noCom) l0) [v1,v2]
- imp1' = imp1 { ideclHiding = Just (True,impHiding)}
- p' = p { hsmodImports = [L li imp1',imp2]}
- return (L l p')
-
- let (lp',(_ans',_),_w) = runTransform mempty doTransform
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
--- ---------------------------------------------------------------------
-
-addHiding2 :: Changer
-addHiding2 _libdir ans (L l p) = do
- let doTransform = do
- l1 <- uniqueSrcSpanT
- l2 <- uniqueSrcSpanT
- let
- [L li imp1] = hsmodImports p
- Just (_,L lh ns) = ideclHiding imp1
- lh' = (SrcSpanAnn (ApiAnn (Anchor (realSrcSpan (locA lh)) m0)
- (AnnList Nothing
- (Just (AddApiAnn AnnOpenP d1))
- (Just (AddApiAnn AnnCloseP d0))
- [(AddApiAnn AnnHiding d1)]
- [])
- noCom) (locA lh))
- n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1"))
- n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2"))
- v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1)))
- v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2)))
- L ln n = last ns
- n' = L (addComma ln) n
- imp1' = imp1 { ideclHiding = Just (True,L lh' (init ns ++ [n',v1,v2]))}
- p' = p { hsmodImports = [L li imp1']}
- return (L l p')
-
- let (lp',(_ans',_),_w) = runTransform mempty doTransform
- debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
- return (ans,lp')
-
-
--- ---------------------------------------------------------------------
--- From SYB
-
--- | Apply transformation on each level of a tree.
---
--- Just like 'everything', this is stolen from SYB package.
-everywhere :: (forall a. Data a => a -> a) -> (forall a. Data a => a -> a)
-everywhere f = f . gmapT (everywhere f)
-
--- | Create generic transformation.
---
--- Another function stolen from SYB package.
-mkT :: (Typeable a, Typeable b) => (b -> b) -> (a -> a)
-mkT f = case cast f of
- Just f' -> f'
- Nothing -> id
-
--- ---------------------------------------------------------------------
diff --git a/utils/check-exact/cases/AddDecl1.expected.hs b/utils/check-exact/cases/AddDecl1.expected.hs
deleted file mode 100644
index 88ef0fdd7d..0000000000
--- a/utils/check-exact/cases/AddDecl1.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module AddDecl where
-
-nn = n2
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
--- end of file
diff --git a/utils/check-exact/cases/AddDecl1.hs b/utils/check-exact/cases/AddDecl1.hs
deleted file mode 100644
index 45c0cb3864..0000000000
--- a/utils/check-exact/cases/AddDecl1.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module AddDecl where
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
--- end of file
diff --git a/utils/check-exact/cases/AddDecl2.expected.hs b/utils/check-exact/cases/AddDecl2.expected.hs
deleted file mode 100644
index 2bbbcf5b37..0000000000
--- a/utils/check-exact/cases/AddDecl2.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module AddDecl where
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
-nn = n2
-
--- end of file
diff --git a/utils/check-exact/cases/AddDecl2.hs b/utils/check-exact/cases/AddDecl2.hs
deleted file mode 100644
index 45c0cb3864..0000000000
--- a/utils/check-exact/cases/AddDecl2.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module AddDecl where
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
--- end of file
diff --git a/utils/check-exact/cases/AddDecl3.expected.hs b/utils/check-exact/cases/AddDecl3.expected.hs
deleted file mode 100644
index dd3044fcc5..0000000000
--- a/utils/check-exact/cases/AddDecl3.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module AddDecl where
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
-nn = n2
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
--- end of file
diff --git a/utils/check-exact/cases/AddDecl3.hs b/utils/check-exact/cases/AddDecl3.hs
deleted file mode 100644
index 45c0cb3864..0000000000
--- a/utils/check-exact/cases/AddDecl3.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module AddDecl where
-
--- Adding a declaration to an existing file
-
--- | Do foo
-foo a b = a + b
-
--- | Do bar
-bar x y = {- baz -} foo (x+y) x
-
--- end of file
diff --git a/utils/check-exact/cases/AddHiding1.expected.hs b/utils/check-exact/cases/AddHiding1.expected.hs
deleted file mode 100644
index f3c8f17c8b..0000000000
--- a/utils/check-exact/cases/AddHiding1.expected.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module AddHiding1 where
-
-import Data.Maybe hiding (n1,n2)
-
-import Data.Maybe hiding (n1,n2)
-
-f = 1
-
diff --git a/utils/check-exact/cases/AddHiding1.hs b/utils/check-exact/cases/AddHiding1.hs
deleted file mode 100644
index abcd47879a..0000000000
--- a/utils/check-exact/cases/AddHiding1.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module AddHiding1 where
-
-import Data.Maybe
-
-import Data.Maybe hiding (n1,n2)
-
-f = 1
-
diff --git a/utils/check-exact/cases/AddHiding2.expected.hs b/utils/check-exact/cases/AddHiding2.expected.hs
deleted file mode 100644
index d62005227b..0000000000
--- a/utils/check-exact/cases/AddHiding2.expected.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module AddHiding2 where
-
-import Data.Maybe hiding (f1,f2,n1,n2)
-
-f = 1
diff --git a/utils/check-exact/cases/AddHiding2.hs b/utils/check-exact/cases/AddHiding2.hs
deleted file mode 100644
index f5f551a9cb..0000000000
--- a/utils/check-exact/cases/AddHiding2.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module AddHiding2 where
-
-import Data.Maybe hiding (f1,f2)
-
-f = 1
diff --git a/utils/check-exact/cases/AddLocalDecl1.expected.hs b/utils/check-exact/cases/AddLocalDecl1.expected.hs
deleted file mode 100644
index 023e2ea05d..0000000000
--- a/utils/check-exact/cases/AddLocalDecl1.expected.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module AddLocalDecl1 where
-
--- |This is a function
-foo = x -- comment1
- where
- nn = 2
--- trailing 1
-
--- |Another fun
-x = a -- comment2
- where
- a = 3
--- trailing 2
-
-y = 3
diff --git a/utils/check-exact/cases/AddLocalDecl1.hs b/utils/check-exact/cases/AddLocalDecl1.hs
deleted file mode 100644
index 3bb4953c51..0000000000
--- a/utils/check-exact/cases/AddLocalDecl1.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module AddLocalDecl1 where
-
--- |This is a function
-foo = x -- comment1
--- trailing 1
-
--- |Another fun
-x = a -- comment2
- where
- a = 3
--- trailing 2
-
-y = 3
diff --git a/utils/check-exact/cases/AddLocalDecl2.expected.hs b/utils/check-exact/cases/AddLocalDecl2.expected.hs
deleted file mode 100644
index ff25b79157..0000000000
--- a/utils/check-exact/cases/AddLocalDecl2.expected.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module AddLocalDecl2 where
-
--- |This is a function
-foo = x -- comment 0
- where nn = 2
- p = 2 -- comment 1
-
--- |Another fun
-bar = a -- comment 2
- where nn = 2
- p = 2 -- comment 3
diff --git a/utils/check-exact/cases/AddLocalDecl2.hs b/utils/check-exact/cases/AddLocalDecl2.hs
deleted file mode 100644
index 7609f657ed..0000000000
--- a/utils/check-exact/cases/AddLocalDecl2.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module AddLocalDecl2 where
-
--- |This is a function
-foo = x -- comment 0
- where p = 2 -- comment 1
-
--- |Another fun
-bar = a -- comment 2
- where nn = 2
- p = 2 -- comment 3
diff --git a/utils/check-exact/cases/AddLocalDecl3.expected.hs b/utils/check-exact/cases/AddLocalDecl3.expected.hs
deleted file mode 100644
index deaf1e7cb8..0000000000
--- a/utils/check-exact/cases/AddLocalDecl3.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module AddLocalDecl3 where
-
--- |This is a function
-foo = x -- comment 0
- where p = 2 -- comment 1
- nn = 2
- -- comment f
-
--- |Another fun
-bar = a -- comment 2
- where p = 2 -- comment 3
- nn = 2
- -- comment b
diff --git a/utils/check-exact/cases/AddLocalDecl3.hs b/utils/check-exact/cases/AddLocalDecl3.hs
deleted file mode 100644
index eb14013031..0000000000
--- a/utils/check-exact/cases/AddLocalDecl3.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module AddLocalDecl3 where
-
--- |This is a function
-foo = x -- comment 0
- where p = 2 -- comment 1
- -- comment f
-
--- |Another fun
-bar = a -- comment 2
- where p = 2 -- comment 3
- nn = 2
- -- comment b
diff --git a/utils/check-exact/cases/AddLocalDecl4.expected.hs b/utils/check-exact/cases/AddLocalDecl4.expected.hs
deleted file mode 100644
index b3c1445d0d..0000000000
--- a/utils/check-exact/cases/AddLocalDecl4.expected.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module AddLocalDecl4 where
-
-toplevel x = c * x
- where
- nn :: Int
- nn = 2
diff --git a/utils/check-exact/cases/AddLocalDecl4.hs b/utils/check-exact/cases/AddLocalDecl4.hs
deleted file mode 100644
index 2ec2c0bf73..0000000000
--- a/utils/check-exact/cases/AddLocalDecl4.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module AddLocalDecl4 where
-
-toplevel x = c * x
diff --git a/utils/check-exact/cases/AddLocalDecl5.expected.hs b/utils/check-exact/cases/AddLocalDecl5.expected.hs
deleted file mode 100644
index 5e66dc5a6b..0000000000
--- a/utils/check-exact/cases/AddLocalDecl5.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module AddLocalDecl5 where
-
-toplevel :: Integer -> Integer
-toplevel x = c * x
- where
- -- c,d :: Integer
- c = 7
-
-d = 9
diff --git a/utils/check-exact/cases/AddLocalDecl5.hs b/utils/check-exact/cases/AddLocalDecl5.hs
deleted file mode 100644
index 9f07e1071b..0000000000
--- a/utils/check-exact/cases/AddLocalDecl5.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module AddLocalDecl5 where
-
-toplevel :: Integer -> Integer
-toplevel x = c * x
-
--- c,d :: Integer
-c = 7
-d = 9
diff --git a/utils/check-exact/cases/AddLocalDecl6.expected.hs b/utils/check-exact/cases/AddLocalDecl6.expected.hs
deleted file mode 100644
index 9cedb7d63f..0000000000
--- a/utils/check-exact/cases/AddLocalDecl6.expected.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module AddLocalDecl6 where
-
-foo [] = 1 -- comment 0
- where
- x = 3
-foo xs = 2 -- comment 1
-
-bar [] = 1 -- comment 2
- where
- x = 3
-bar xs = 2 -- comment 3
-
diff --git a/utils/check-exact/cases/AddLocalDecl6.hs b/utils/check-exact/cases/AddLocalDecl6.hs
deleted file mode 100644
index d0bdffca41..0000000000
--- a/utils/check-exact/cases/AddLocalDecl6.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module AddLocalDecl6 where
-
-foo [] = 1 -- comment 0
-foo xs = 2 -- comment 1
-
-bar [] = 1 -- comment 2
- where
- x = 3
-bar xs = 2 -- comment 3
-
diff --git a/utils/check-exact/cases/EmptyWheres.hs b/utils/check-exact/cases/EmptyWheres.hs
deleted file mode 100644
index edc0570012..0000000000
--- a/utils/check-exact/cases/EmptyWheres.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module EmptyWheres where
-
-x = 2 where
-y = 3
-
-instance Foo1 Int where
-
-ff = ff where g = g where
-type T = Int
diff --git a/utils/check-exact/cases/LayoutIn1.expected.hs b/utils/check-exact/cases/LayoutIn1.expected.hs
deleted file mode 100644
index 2b23b21853..0000000000
--- a/utils/check-exact/cases/LayoutIn1.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module LayoutIn1 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'sq' to 'square'.
-
-sumSquares x y= square x + square y where sq x= x^pow
- --There is a comment.
- pow=2
diff --git a/utils/check-exact/cases/LayoutIn1.hs b/utils/check-exact/cases/LayoutIn1.hs
deleted file mode 100644
index 3ea1f8402c..0000000000
--- a/utils/check-exact/cases/LayoutIn1.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module LayoutIn1 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'sq' to 'square'.
-
-sumSquares x y= sq x + sq y where sq x= x^pow
- --There is a comment.
- pow=2
diff --git a/utils/check-exact/cases/LayoutIn3.expected.hs b/utils/check-exact/cases/LayoutIn3.expected.hs
deleted file mode 100644
index 900d6daf63..0000000000
--- a/utils/check-exact/cases/LayoutIn3.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn3 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let anotherX = 12 in (let y = 3
- z = 2 in anotherX * y * z * w) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn3.hs b/utils/check-exact/cases/LayoutIn3.hs
deleted file mode 100644
index c8c110d65c..0000000000
--- a/utils/check-exact/cases/LayoutIn3.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn3 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let x = 12 in (let y = 3
- z = 2 in x * y * z * w) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn3a.expected.hs b/utils/check-exact/cases/LayoutIn3a.expected.hs
deleted file mode 100644
index c0a552c0d0..0000000000
--- a/utils/check-exact/cases/LayoutIn3a.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn3a where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let anotherX = 12 in (
- anotherX ) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn3a.hs b/utils/check-exact/cases/LayoutIn3a.hs
deleted file mode 100644
index 58b36b07f8..0000000000
--- a/utils/check-exact/cases/LayoutIn3a.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn3a where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let x = 12 in (
- x ) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn3b.expected.hs b/utils/check-exact/cases/LayoutIn3b.expected.hs
deleted file mode 100644
index 057d9d346a..0000000000
--- a/utils/check-exact/cases/LayoutIn3b.expected.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module LayoutIn3b where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let anotherX = 12 in ( anotherX ) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn3b.hs b/utils/check-exact/cases/LayoutIn3b.hs
deleted file mode 100644
index 32bc294ae4..0000000000
--- a/utils/check-exact/cases/LayoutIn3b.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module LayoutIn3b where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'x' after 'let' to 'anotherX'.
-
-foo x = let x = 12 in ( x ) where y = 2
- --there is a comment.
- w = x
- where
- x = let y = 5 in y + 3
-
diff --git a/utils/check-exact/cases/LayoutIn4.expected.hs b/utils/check-exact/cases/LayoutIn4.expected.hs
deleted file mode 100644
index 531478da48..0000000000
--- a/utils/check-exact/cases/LayoutIn4.expected.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn4 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'ioFun' to 'io'
-
-main = io "hello" where io s= do let k = reverse s
---There is a comment
- s <- getLine
- let q = (k ++ s)
- putStr q
- putStr "foo"
-
diff --git a/utils/check-exact/cases/LayoutIn4.hs b/utils/check-exact/cases/LayoutIn4.hs
deleted file mode 100644
index d99d05649d..0000000000
--- a/utils/check-exact/cases/LayoutIn4.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module LayoutIn4 where
-
---Layout rule applies after 'where','let','do' and 'of'
-
---In this Example: rename 'ioFun' to 'io'
-
-main = ioFun "hello" where ioFun s= do let k = reverse s
- --There is a comment
- s <- getLine
- let q = (k ++ s)
- putStr q
- putStr "foo"
-
diff --git a/utils/check-exact/cases/LayoutLet2.expected.hs b/utils/check-exact/cases/LayoutLet2.expected.hs
deleted file mode 100644
index 8da499ce3a..0000000000
--- a/utils/check-exact/cases/LayoutLet2.expected.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module LayoutLet2 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxxlonger = let a = 1
- b = 2 in xxxlonger + a + b
diff --git a/utils/check-exact/cases/LayoutLet2.hs b/utils/check-exact/cases/LayoutLet2.hs
deleted file mode 100644
index 378aa587a8..0000000000
--- a/utils/check-exact/cases/LayoutLet2.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module LayoutLet2 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxx = let a = 1
- b = 2 in xxx + a + b
diff --git a/utils/check-exact/cases/LayoutLet3.expected.hs b/utils/check-exact/cases/LayoutLet3.expected.hs
deleted file mode 100644
index 797cf5f483..0000000000
--- a/utils/check-exact/cases/LayoutLet3.expected.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module LayoutLet3 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxxlonger = let a = 1
- b = 2
- in xxxlonger + a + b
-
diff --git a/utils/check-exact/cases/LayoutLet3.hs b/utils/check-exact/cases/LayoutLet3.hs
deleted file mode 100644
index 5ba80aff6a..0000000000
--- a/utils/check-exact/cases/LayoutLet3.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module LayoutLet3 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxx = let a = 1
- b = 2
- in xxx + a + b
-
diff --git a/utils/check-exact/cases/LayoutLet4.expected.hs b/utils/check-exact/cases/LayoutLet4.expected.hs
deleted file mode 100644
index b3c52f424e..0000000000
--- a/utils/check-exact/cases/LayoutLet4.expected.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module LayoutLet4 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxxlonger = let a = 1
- b = 2
- in xxxlonger + a + b
-
-bar = 3
-
diff --git a/utils/check-exact/cases/LayoutLet4.hs b/utils/check-exact/cases/LayoutLet4.hs
deleted file mode 100644
index 28fe599432..0000000000
--- a/utils/check-exact/cases/LayoutLet4.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module LayoutLet4 where
-
--- Simple let expression, rename xxx to something longer or shorter
--- and the let/in layout should adjust accordingly
--- In this case the tokens for xxx + a + b should also shift out
-
-foo xxx = let a = 1
- b = 2
- in xxx + a + b
-
-bar = 3
-
diff --git a/utils/check-exact/cases/LetIn1.expected.hs b/utils/check-exact/cases/LetIn1.expected.hs
deleted file mode 100644
index d233115ee6..0000000000
--- a/utils/check-exact/cases/LetIn1.expected.hs
+++ /dev/null
@@ -1,18 +0,0 @@
-module LetIn1 where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the local 'pow' to 'sq'
---This example also aims to test the demoting a local declaration in 'let'.
-
-sumSquares x y = let sq 0=0
- sq z=z^pow
- in sq x + sq y
-
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
-
diff --git a/utils/check-exact/cases/LetIn1.hs b/utils/check-exact/cases/LetIn1.hs
deleted file mode 100644
index f1109b8f03..0000000000
--- a/utils/check-exact/cases/LetIn1.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module LetIn1 where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the local 'pow' to 'sq'
---This example also aims to test the demoting a local declaration in 'let'.
-
-sumSquares x y = let sq 0=0
- sq z=z^pow
- pow=2
- in sq x + sq y
-
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
-
diff --git a/utils/check-exact/cases/LocToName.expected.hs b/utils/check-exact/cases/LocToName.expected.hs
deleted file mode 100644
index 0b1484873a..0000000000
--- a/utils/check-exact/cases/LocToName.expected.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module LocToName where
-
-{-
-
-
-
-
-
-
-
-
--}
-
-
-
-
-
-
-
-LocToName.newPoint (x:xs) = x ^2 + LocToName.newPoint xs
- -- where sq x = x ^pow
- -- pow = 2
-
-LocToName.newPoint [] = 0
-
diff --git a/utils/check-exact/cases/LocToName.hs b/utils/check-exact/cases/LocToName.hs
deleted file mode 100644
index 89a0acea12..0000000000
--- a/utils/check-exact/cases/LocToName.hs
+++ /dev/null
@@ -1,25 +0,0 @@
-module LocToName where
-
-{-
-
-
-
-
-
-
-
-
--}
-
-
-
-
-
-
-
-sumSquares (x:xs) = x ^2 + sumSquares xs
- -- where sq x = x ^pow
- -- pow = 2
-
-sumSquares [] = 0
-
diff --git a/utils/check-exact/cases/LocalDecls.expected.hs b/utils/check-exact/cases/LocalDecls.expected.hs
deleted file mode 100644
index 7c41178ba0..0000000000
--- a/utils/check-exact/cases/LocalDecls.expected.hs
+++ /dev/null
@@ -1,11 +0,0 @@
-module LocalDecls where
-
-foo a = bar a
- where
- nn :: Int
- nn = 2
-
- bar :: Int -> Int
- bar x = x + 2
-
- baz = 4
diff --git a/utils/check-exact/cases/LocalDecls.hs b/utils/check-exact/cases/LocalDecls.hs
deleted file mode 100644
index ebb774ac63..0000000000
--- a/utils/check-exact/cases/LocalDecls.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module LocalDecls where
-
-foo a = bar a
- where
- bar :: Int -> Int
- bar x = x + 2
-
- baz = 4
diff --git a/utils/check-exact/cases/LocalDecls2.expected.hs b/utils/check-exact/cases/LocalDecls2.expected.hs
deleted file mode 100644
index d2353e94c5..0000000000
--- a/utils/check-exact/cases/LocalDecls2.expected.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module LocalDecls2 where
-
-foo a = bar a
- where
- nn :: Int
- nn = 2
-
-
diff --git a/utils/check-exact/cases/LocalDecls2.hs b/utils/check-exact/cases/LocalDecls2.hs
deleted file mode 100644
index 92a8649649..0000000000
--- a/utils/check-exact/cases/LocalDecls2.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module LocalDecls2 where
-
-foo a = bar a
diff --git a/utils/check-exact/cases/Rename1.expected.hs b/utils/check-exact/cases/Rename1.expected.hs
deleted file mode 100644
index 353a7420e2..0000000000
--- a/utils/check-exact/cases/Rename1.expected.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Rename1 where
-
-bar2 x y =
- do c <- getChar
- return c
-
diff --git a/utils/check-exact/cases/Rename1.hs b/utils/check-exact/cases/Rename1.hs
deleted file mode 100644
index 1ad343afd3..0000000000
--- a/utils/check-exact/cases/Rename1.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Rename1 where
-
-foo x y =
- do c <- getChar
- return c
-
diff --git a/utils/check-exact/cases/Rename2.expected.hs b/utils/check-exact/cases/Rename2.expected.hs
deleted file mode 100644
index 6be3ff6e0a..0000000000
--- a/utils/check-exact/cases/Rename2.expected.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-
-joe x = case (odd x) of
- True -> "Odd"
- False -> "Even"
diff --git a/utils/check-exact/cases/Rename2.hs b/utils/check-exact/cases/Rename2.hs
deleted file mode 100644
index 29fea060c2..0000000000
--- a/utils/check-exact/cases/Rename2.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-
-foo' x = case (odd x) of
- True -> "Odd"
- False -> "Even"
diff --git a/utils/check-exact/cases/RenameCase1.expected.hs b/utils/check-exact/cases/RenameCase1.expected.hs
deleted file mode 100644
index dad6765012..0000000000
--- a/utils/check-exact/cases/RenameCase1.expected.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module RenameCase1 where
-
-foo x = case (bazLonger x) of
- 1 -> "a"
- _ -> "b"
diff --git a/utils/check-exact/cases/RenameCase1.hs b/utils/check-exact/cases/RenameCase1.hs
deleted file mode 100644
index 22d549367a..0000000000
--- a/utils/check-exact/cases/RenameCase1.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module RenameCase1 where
-
-foo x = case (baz x) of
- 1 -> "a"
- _ -> "b"
diff --git a/utils/check-exact/cases/RmDecl1.expected.hs b/utils/check-exact/cases/RmDecl1.expected.hs
deleted file mode 100644
index 6bb503aede..0000000000
--- a/utils/check-exact/cases/RmDecl1.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl1 where
-
-sumSquares x = x * p
- where p=2 {-There is a comment-}
-
-{- foo bar -}
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/RmDecl1.hs b/utils/check-exact/cases/RmDecl1.hs
deleted file mode 100644
index 15cd9f1e04..0000000000
--- a/utils/check-exact/cases/RmDecl1.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module RmDecl1 where
-
-sumSquares x = x * p
- where p=2 {-There is a comment-}
-
-sq :: Int -> Int -> Int
-sq pow 0 = 0
-sq pow z = z^pow --there is a comment
-
-{- foo bar -}
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/RmDecl2.expected.hs b/utils/check-exact/cases/RmDecl2.expected.hs
deleted file mode 100644
index d77b760dca..0000000000
--- a/utils/check-exact/cases/RmDecl2.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl2 where
-
-sumSquares x y = let sq 0=0
- sq z=z^pow
- in sq x + sq y
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/RmDecl2.hs b/utils/check-exact/cases/RmDecl2.hs
deleted file mode 100644
index 2f0dbd3ace..0000000000
--- a/utils/check-exact/cases/RmDecl2.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module RmDecl2 where
-
-sumSquares x y = let sq 0=0
- sq z=z^pow
- pow=2
- in sq x + sq y
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/RmDecl3.expected.hs b/utils/check-exact/cases/RmDecl3.expected.hs
deleted file mode 100644
index ca14f33ad5..0000000000
--- a/utils/check-exact/cases/RmDecl3.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl3 where
-
--- Remove last declaration from a where clause, where should disappear too
-ff y = y + zz
-
-zz = 1
-
-foo = 3
--- EOF
diff --git a/utils/check-exact/cases/RmDecl3.hs b/utils/check-exact/cases/RmDecl3.hs
deleted file mode 100644
index 280bccf259..0000000000
--- a/utils/check-exact/cases/RmDecl3.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl3 where
-
--- Remove last declaration from a where clause, where should disappear too
-ff y = y + zz
- where
- zz = 1
-
-foo = 3
--- EOF
diff --git a/utils/check-exact/cases/RmDecl4.expected.hs b/utils/check-exact/cases/RmDecl4.expected.hs
deleted file mode 100644
index e7c71dbd08..0000000000
--- a/utils/check-exact/cases/RmDecl4.expected.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module RmDecl4 where
-
--- Remove first declaration from a where clause, last should still be indented
-ff y = y + zz + xx
- where
- xx = 2
-
-zz = 1
-
--- EOF
diff --git a/utils/check-exact/cases/RmDecl4.hs b/utils/check-exact/cases/RmDecl4.hs
deleted file mode 100644
index 532b738763..0000000000
--- a/utils/check-exact/cases/RmDecl4.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl4 where
-
--- Remove first declaration from a where clause, last should still be indented
-ff y = y + zz + xx
- where
- zz = 1
- xx = 2
-
--- EOF
diff --git a/utils/check-exact/cases/RmDecl5.expected.hs b/utils/check-exact/cases/RmDecl5.expected.hs
deleted file mode 100644
index 67ac8ddfab..0000000000
--- a/utils/check-exact/cases/RmDecl5.expected.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-module RmDecl5 where
-
-sumSquares x y = let pow=2
- in sq x + sq y
-
diff --git a/utils/check-exact/cases/RmDecl5.hs b/utils/check-exact/cases/RmDecl5.hs
deleted file mode 100644
index 40f86199ce..0000000000
--- a/utils/check-exact/cases/RmDecl5.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module RmDecl5 where
-
-sumSquares x y = let sq 0=0
- sq z=z^pow
- pow=2
- in sq x + sq y
-
diff --git a/utils/check-exact/cases/RmDecl6.expected.hs b/utils/check-exact/cases/RmDecl6.expected.hs
deleted file mode 100644
index a2bd7d0443..0000000000
--- a/utils/check-exact/cases/RmDecl6.expected.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl6 where
-
-foo a = baz
- where
- x = 1
-
- y :: Int -> Int -> Int
- y a b = undefined
-
diff --git a/utils/check-exact/cases/RmDecl6.hs b/utils/check-exact/cases/RmDecl6.hs
deleted file mode 100644
index cab5093ce8..0000000000
--- a/utils/check-exact/cases/RmDecl6.hs
+++ /dev/null
@@ -1,12 +0,0 @@
-module RmDecl6 where
-
-foo a = baz
- where
- baz :: Int
- baz = x + a
-
- x = 1
-
- y :: Int -> Int -> Int
- y a b = undefined
-
diff --git a/utils/check-exact/cases/RmDecl7.expected.hs b/utils/check-exact/cases/RmDecl7.expected.hs
deleted file mode 100644
index 9d7b8b9a69..0000000000
--- a/utils/check-exact/cases/RmDecl7.expected.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module RmDecl7 where
-
-toplevel :: Integer -> Integer
-toplevel x = c * x
-
-d = 9
-
diff --git a/utils/check-exact/cases/RmDecl7.hs b/utils/check-exact/cases/RmDecl7.hs
deleted file mode 100644
index 62cefe2154..0000000000
--- a/utils/check-exact/cases/RmDecl7.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module RmDecl7 where
-
-toplevel :: Integer -> Integer
-toplevel x = c * x
-
--- c,d :: Integer
-c = 7
-d = 9
-
diff --git a/utils/check-exact/cases/RmTypeSig1.expected.hs b/utils/check-exact/cases/RmTypeSig1.expected.hs
deleted file mode 100644
index 46f7b13399..0000000000
--- a/utils/check-exact/cases/RmTypeSig1.expected.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module RmTypeSig1 where
-
-anotherFun :: Int -> Int
-sq 0 = 0
-sq z = z^2
-
-anotherFun x = x^2
-
diff --git a/utils/check-exact/cases/RmTypeSig1.hs b/utils/check-exact/cases/RmTypeSig1.hs
deleted file mode 100644
index 498892d791..0000000000
--- a/utils/check-exact/cases/RmTypeSig1.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module RmTypeSig1 where
-
-sq,anotherFun :: Int -> Int
-sq 0 = 0
-sq z = z^2
-
-anotherFun x = x^2
-
diff --git a/utils/check-exact/cases/RmTypeSig2.expected.hs b/utils/check-exact/cases/RmTypeSig2.expected.hs
deleted file mode 100644
index c30e201bd0..0000000000
--- a/utils/check-exact/cases/RmTypeSig2.expected.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module RmTypeSig2 where
-
--- Pattern bind
-tup@(h,t) = (1,ff)
- where
- ff = 15
-
diff --git a/utils/check-exact/cases/RmTypeSig2.hs b/utils/check-exact/cases/RmTypeSig2.hs
deleted file mode 100644
index e8771f99dd..0000000000
--- a/utils/check-exact/cases/RmTypeSig2.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module RmTypeSig2 where
-
--- Pattern bind
-tup@(h,t) = (1,ff)
- where
- ff :: Int
- ff = 15
-
diff --git a/utils/check-exact/cases/WhereIn3a.expected.hs b/utils/check-exact/cases/WhereIn3a.expected.hs
deleted file mode 100644
index acc94d3621..0000000000
--- a/utils/check-exact/cases/WhereIn3a.expected.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module WhereIn3a where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there are multi matches), the parameters are not folded after demoting.
-
-sumSquares x y = sq p x + sq p y
- where p=2 {-There is a comment-}
-
-sq :: Int -> Int -> Int
-sq pow 0 = 0 -- prior comment
-sq pow z = z^pow --there is a comment
-
--- A leading comment
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/WhereIn3a.hs b/utils/check-exact/cases/WhereIn3a.hs
deleted file mode 100644
index acc94d3621..0000000000
--- a/utils/check-exact/cases/WhereIn3a.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module WhereIn3a where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there are multi matches), the parameters are not folded after demoting.
-
-sumSquares x y = sq p x + sq p y
- where p=2 {-There is a comment-}
-
-sq :: Int -> Int -> Int
-sq pow 0 = 0 -- prior comment
-sq pow z = z^pow --there is a comment
-
--- A leading comment
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/WhereIn3b.expected.hs b/utils/check-exact/cases/WhereIn3b.expected.hs
deleted file mode 100644
index 80ddc04825..0000000000
--- a/utils/check-exact/cases/WhereIn3b.expected.hs
+++ /dev/null
@@ -1,27 +0,0 @@
-module WhereIn3a where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there are multi matches), the parameters are not folded after demoting.
-
--- A leading comment
-anotherFun 0 y = sq y
- where sq x = x^2
-
-sq pow 0 = 0 -- prior comment
-sq pow z = z^pow --there is a comment
-
-sumSquares x y = sq p x + sq p y
- where p=2 {-There is a comment-}
-
-sq :: Int -> Int -> Int
-sq pow 0 = 0 -- prior comment
-sq pow z = z^pow --there is a comment
-
--- A leading comment
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/WhereIn3b.hs b/utils/check-exact/cases/WhereIn3b.hs
deleted file mode 100644
index acc94d3621..0000000000
--- a/utils/check-exact/cases/WhereIn3b.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-module WhereIn3a where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there are multi matches), the parameters are not folded after demoting.
-
-sumSquares x y = sq p x + sq p y
- where p=2 {-There is a comment-}
-
-sq :: Int -> Int -> Int
-sq pow 0 = 0 -- prior comment
-sq pow z = z^pow --there is a comment
-
--- A leading comment
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/WhereIn4.expected.hs b/utils/check-exact/cases/WhereIn4.expected.hs
deleted file mode 100644
index 4357bfdac7..0000000000
--- a/utils/check-exact/cases/WhereIn4.expected.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module WhereIn4 where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there is single matches), if possible,
---the parameters will be folded after demoting and type sigature will be removed.
-
-sumSquares x y = sq p x + sq p y
- where p_2=2 {-There is a comment-}
-
-sq::Int->Int->Int
-sq pow z = z^pow --there is a comment
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/WhereIn4.hs b/utils/check-exact/cases/WhereIn4.hs
deleted file mode 100644
index 8b941fff4a..0000000000
--- a/utils/check-exact/cases/WhereIn4.hs
+++ /dev/null
@@ -1,19 +0,0 @@
-module WhereIn4 where
-
---A definition can be demoted to the local 'where' binding of a friend declaration,
---if it is only used by this friend declaration.
-
---Demoting a definition narrows down the scope of the definition.
---In this example, demote the top level 'sq' to 'sumSquares'
---In this case (there is single matches), if possible,
---the parameters will be folded after demoting and type sigature will be removed.
-
-sumSquares x y = sq p x + sq p y
- where p=2 {-There is a comment-}
-
-sq::Int->Int->Int
-sq pow z = z^pow --there is a comment
-
-anotherFun 0 y = sq y
- where sq x = x^2
-
diff --git a/utils/check-exact/cases/Windows.hs b/utils/check-exact/cases/Windows.hs
deleted file mode 100644
index ad8ae692b6..0000000000
--- a/utils/check-exact/cases/Windows.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Windows where
-
-{-
- This file has windows-style line endings, to check that trailing
- \r's get stripped in comments.
--}
-baz = 2
-
--- Another comment
-foo = 1