content: {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE StandaloneDeriving #-}
  {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE BangPatterns #-}
  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
  {-# OPTIONS_GHC -Wno-incomplete-patterns #-}
  {-# OPTIONS_GHC -Wno-orphans #-}
  
  import Data.Data
  import Data.List (intercalate)
  import GHC hiding (moduleName)
  import GHC.Driver.Errors.Types
  import GHC.Driver.Ppr
  import GHC.Hs.Dump
  import GHC.Types.Error
  import GHC.Types.Name.Occurrence
  import GHC.Types.Name.Reader
  import GHC.Utils.Error
  import GHC.Utils.Outputable
  import System.Environment( getArgs )
  import System.Exit
  import System.FilePath
  import System.IO
  
  import Types
  import Utils
  import ExactPrint
  import Transform
  import Parsers
  
  import GHC.Parser.Lexer
  import GHC.Data.FastString
  
  -- ---------------------------------------------------------------------
  
  _tt :: IO ()
  -- _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/master/_build/stage1/lib/"
  -- _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" (Just changeRenameCase1)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet2.hs" (Just changeLayoutLet2)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet3.hs" (Just changeLayoutLet3)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutLet4.hs" (Just changeLayoutLet3)
   -- "../../testsuite/tests/ghc-api/exactprint/Rename1.hs" (Just changeRename1)
   -- "../../testsuite/tests/ghc-api/exactprint/Rename2.hs" (Just changeRename2)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn1.hs" (Just changeLayoutIn1)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3.hs" (Just changeLayoutIn3)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3a.hs" (Just changeLayoutIn3)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn3b.hs" (Just changeLayoutIn3)
   -- "../../testsuite/tests/ghc-api/exactprint/LayoutIn4.hs" (Just changeLayoutIn4)
   -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" (Just changeLocToName)
   -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1)
   -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4)
   -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1)
   -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2)
   -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3)
   -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls)
   -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls2.hs" (Just changeLocalDecls2)
   -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3a.hs" (Just changeWhereIn3a)
   -- "../../testsuite/tests/ghc-api/exactprint/WhereIn3b.hs" (Just changeWhereIn3b)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl1.hs" (Just addLocaLDecl1)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl2.hs" (Just addLocaLDecl2)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" (Just addLocaLDecl3)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5)
   -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6)
   -- "../../testsuite/tests/ghc-api/exactprint/AddClassMethod.hs" (Just addClassMethod)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl4.hs" (Just rmDecl4)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl5.hs" (Just rmDecl5)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl6.hs" (Just rmDecl6)
   -- "../../testsuite/tests/ghc-api/exactprint/RmDecl7.hs" (Just rmDecl7)
   -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig1.hs" (Just rmTypeSig1)
   -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" (Just rmTypeSig2)
   -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" (Just addHiding1)
   -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" (Just addHiding2)
   -- "../../testsuite/tests/ghc-api/exactprint/AddClassMethod.hs" (Just addClassMethod)
   -- "../../testsuite/tests/ghc-api/exactprint/Haddock2.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/Ppr011a.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/MatchPatComments.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/PprUnicodeSyntax.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/Test10268.hs" Nothing
   -- "../../testsuite/tests/printer/Test10269.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/printer/InTreeAnnotations1.hs" Nothing
   -- "../../testsuite/tests/printer/Test19798.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
   -- "../../testsuite/tests/printer/Test19784.hs" Nothing
   -- "../../testsuite/tests/printer/Test19813.hs" Nothing
   -- "../../testsuite/tests/printer/Test19814.hs" Nothing
   -- "../../testsuite/tests/printer/Test19821.hs" Nothing
   -- "../../testsuite/tests/printer/Test19834.hs" Nothing
   -- "../../testsuite/tests/printer/Test19840.hs" Nothing
   -- "../../testsuite/tests/printer/Test19850.hs" Nothing
   -- "../../testsuite/tests/printer/Test20247.hs" Nothing
   -- "../../testsuite/tests/printer/Test20258.hs" Nothing
   -- "../../testsuite/tests/printer/Test20297.hs" Nothing
   -- "../../testsuite/tests/printer/PprLinearArrow.hs" Nothing
   -- "../../testsuite/tests/printer/PprRecordSemi.hs" Nothing
   -- "../../testsuite/tests/printer/PprSemis.hs" Nothing
   -- "../../testsuite/tests/printer/PprEmptyMostly.hs" Nothing
   -- "../../testsuite/tests/parser/should_compile/DumpSemis.hs" Nothing
   -- "../../testsuite/tests/ghc-api/exactprint/Test20239.hs" Nothing
   -- "../../testsuite/tests/printer/PprArrowLambdaCase.hs" Nothing
   -- "../../testsuite/tests/printer/PprParenFunBind.hs" Nothing
   -- "../../testsuite/tests/printer/Test16279.hs" Nothing
   -- "../../testsuite/tests/printer/HsDocTy.hs" Nothing
   -- "../../testsuite/tests/printer/Test21355.hs" Nothing
   --  "../../testsuite/tests/printer/Test22765.hs" Nothing
   -- "../../testsuite/tests/printer/Test22771.hs" Nothing
   -- "../../testsuite/tests/printer/Test23465.hs" Nothing
   -- "../../testsuite/tests/printer/Test25454.hs" Nothing
   "../../testsuite/tests/printer/Test25467.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)
    ,("addClassMethod",    addClassMethod)
     ]
  
  -- ---------------------------------------------------------------------
  
  usage :: String
  usage = unlines
      [ "usage: check-exact (libdir) (file)"
      , "       check-exact (libdir) (file) (changer)"
      , ""
      , "where libdir is the GHC library directory (e.g. the output of"
      , "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
     [] -> _tt
     [libdir,fileName] -> testOneFile changers libdir fileName Nothing
     [libdir,fileName,changerStr] -> do
       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
  
  writeBinFile :: FilePath -> String -> IO()
  writeBinFile fpath x = withBinaryFile fpath WriteMode (\h -> hSetEncoding h utf8 >> hPutStr h x)
  
  testOneFile :: [(String, Changer)] -> FilePath -> String -> Maybe Changer -> IO ()
  testOneFile _ libdir fileName mchanger = do
         (p,_toks) <- parseOneFile libdir fileName
         let
           origAst = ppAst p
           pped    = exactPrint p
  
           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"
  
         writeBinFile astFile origAst
         writeBinFile newFile pped
  
         (changedSourceOk, expectedSource, changedSource) <- case mchanger of
           Just changer -> do
             (pped', ast') <- exactprintWithChange libdir changer p
             writeBinFile changedAstFile (ppAst ast')
             writeBinFile newFileChanged pped'
  
             expectedSource <- readFile newFileExpected
             changedSource  <- readFile newFileChanged
             return (expectedSource == changedSource, expectedSource, changedSource)
           Nothing -> do
             expectedSource <- readFile fileName
             changedSource  <- readFile newFile
             return (expectedSource == changedSource, expectedSource, changedSource)
  
         (p',_) <- parseOneFile libdir newFile
         let newAstStr :: String
             newAstStr = ppAst p'
         writeBinFile newAstFile newAstStr
  
         let origAstOk = origAst == newAstStr
  
         if origAstOk && changedSourceOk
           then do
             exitSuccess
           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 NoBlankEpAnnotations ast
  
  
  parseOneFile :: FilePath -> FilePath -> IO (ParsedSource, [Located Token])
  parseOneFile libdir fileName = do
    res <- parseModuleEpAnnsWithCpp libdir defaultCppOptions fileName
    case res of
      Left m -> error (showErrorMessages m)
      Right (injectedComments, _dflags, pmod) -> do
        let !pmodWithComments = insertCppComments pmod injectedComments
        return (pmodWithComments, [])
  
  showErrorMessages :: Messages GhcMessage -> String
  showErrorMessages msgs =
    renderWithContext defaultSDocContext
      $ vcat
      $ pprMsgEnvelopeBagWithLocDefault
      $ getMessages
      $ msgs
  
  -- ---------------------------------------------------------------------
  
  exactprintWithChange :: FilePath -> Changer -> ParsedSource -> IO (String, ParsedSource)
  exactprintWithChange libdir f p = do
    p' <- f libdir p
    return (exactPrint p', p')
  
  -- First param is libdir
  type Changer = FilePath -> (ParsedSource -> IO ParsedSource)
  
  noChange :: Changer
  noChange _libdir parsed = return parsed
  
  changeRenameCase1 :: Changer
  changeRenameCase1 _libdir parsed = return (rename "bazLonger" [((3,15),(3,18))] parsed)
  
  changeLayoutLet2 :: Changer
  changeLayoutLet2 _libdir parsed = return (rename "xxxlonger" [((7,5),(7,8)),((8,24),(8,27))] parsed)
  
  changeLayoutLet3 :: Changer
  changeLayoutLet3 _libdir parsed = return (rename "xxxlonger" [((7,5),(7,8)),((9,14),(9,17))] parsed)
  
  changeLayoutIn1 :: Changer
  changeLayoutIn1 _libdir parsed = return (rename "square" [((7,17),(7,19)),((7,24),(7,26))] parsed)
  
  changeLayoutIn3 :: Changer
  changeLayoutIn3 _libdir parsed = return (rename "anotherX" [((7,13),(7,14)),((7,37),(7,38)),((8,37),(8,38))] parsed)
  
  changeLayoutIn4 :: Changer
  changeLayoutIn4 _libdir parsed = return (rename "io" [((7,8),(7,13)),((7,28),(7,33))] parsed)
  
  changeLocToName :: Changer
  changeLocToName _libdir parsed = return (rename "LocToName.newPoint" [((20,1),(20,11)),((20,28),(20,38)),((24,1),(24,11))] parsed)
  
  
  changeRename1 :: Changer
  changeRename1 _libdir parsed = return (rename "bar2" [((3,1),(3,4))] parsed)
  
  changeRename2 :: Changer
  changeRename2 _libdir parsed = return (rename "joe" [((2,1),(2,5))] parsed)
  
  rename :: (Data a, ExactPrint 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 parsed
    = return (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 parsed
    = return (everywhere (mkT replace) parsed)
    where
      replace :: HsExpr GhcPs -> HsExpr GhcPs
      replace (HsLet (tkLet, _) localDecls expr)
        =
           let (HsValBinds x (ValBinds xv decls sigs)) = localDecls
               [l2,_l1] = map wrapDecl decls
               decls' = concatMap decl2Bind [l2]
               (L _ e) = expr
               a = EpAnn (EpaDelta noSrcSpan (SameLine 1) []) noAnn emptyComments
               expr' = L a e
               tkIn' = EpTok (EpaDelta noSrcSpan (DifferentLine 1 0) [])
           in (HsLet (tkLet, tkIn')
                  (HsValBinds x (ValBinds xv decls' sigs)) expr')
  
      replace x = x
  
  -- ---------------------------------------------------------------------
  
  -- | Add a declaration to AddDecl
  changeAddDecl1 :: Changer
  changeAddDecl1 libdir top = do
    Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
    let decl' = setEntryDP decl (DifferentLine 2 0)
  
    let (p',_,_) = runTransform doAddDecl
        doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
        replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
        replaceTopLevelDecls m = return $ insertAtStart m decl'
    return p'
  
  -- ---------------------------------------------------------------------
  
  changeAddDecl2 :: Changer
  changeAddDecl2 libdir top = do
    Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
    let decl' = setEntryDP (makeDeltaAst decl) (DifferentLine 2 0)
  
    let (p',_,_) = runTransform doAddDecl
        doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
        replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
        replaceTopLevelDecls m = return $ insertAtEnd m decl'
    return p'
  
  -- ---------------------------------------------------------------------
  
  changeAddDecl3 :: Changer
  changeAddDecl3 libdir top = do
    Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2")
    let decl' = setEntryDP decl (DifferentLine 2 0)
  
    let (p',_,_) = runTransform doAddDecl
        doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
        f d (l1:l2:ls) = (l1:d:l2':ls)
          where
            l2' = setEntryDP l2 (DifferentLine 2 0)
  
        replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
        replaceTopLevelDecls m = return $ insertAt f m decl'
    return p'
  
  -- ---------------------------------------------------------------------
  
  -- | Add a local declaration with signature to LocalDecl
  changeLocalDecls :: Changer
  changeLocalDecls libdir (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) (DifferentLine 1 0)
    let  sig' = setEntryDP (L ls sig)  (SameLine 0)
    let (p',_,_w) = runTransform 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 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 (DifferentLine 2 0)
          let sortKey = captureOrderBinds decls
          let (EpAnn anc (AnnList (Just _) a b c dd) cs) = van
          let van' = (EpAnn anc (AnnList (Just (EpaDelta noSrcSpan (DifferentLine 1 4) [])) a b c dd) cs)
          let binds' = (HsValBinds van'
                            (ValBinds sortKey (decl':oldBinds)
                                            (sig':os':oldSigs)))
          return (L lm (Match an mln pats (GRHSs emptyComments rhs binds')))
                     `debug` ("oldDecls=" ++ showAst oldDecls)
        replaceLocalBinds x = return x
    return (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 (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) (DifferentLine 1 0)
    let  sig' = setEntryDP (L ls  sig) (SameLine 2)
    let (p',_,_w) = runTransform 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
          let anc = (EpaDelta noSrcSpan (DifferentLine 1 2) [])
          let anc2 = (EpaDelta noSrcSpan (DifferentLine 1 4) [])
          let an = EpAnn anc
                          (AnnList (Just anc2) ListNone
                                   []
                                   (EpTok (EpaDelta noSrcSpan (SameLine 0) []))
                                   [])
                          emptyComments
          let decls = [s,d]
          let sortKey = captureOrderBinds decls
          let binds = (HsValBinds an (ValBinds sortKey [decl']
                                      [sig']))
          return (L lm (Match ma mln pats (GRHSs emptyComments rhs binds)))
        replaceLocalBinds x = return x
    return (L l p')
  
  -- ---------------------------------------------------------------------
  
  -- | Check that balanceCommentsList is idempotent
  changeWhereIn3a :: Changer
  changeWhereIn3a _libdir (L l p) = do
    let decls0 = hsmodDecls p
        decls = balanceCommentsList decls0
        (_de0:_:de1:_d2:_) = decls
    debugM $ "changeWhereIn3a:de1:" ++ showAst de1
    let p2 = p { hsmodDecls = decls}
    return (L l p2)
  
  -- ---------------------------------------------------------------------
  
  changeWhereIn3b :: Changer
  changeWhereIn3b _libdir (L l p) = do
    let decls0 = hsmodDecls p
        decls = balanceCommentsList decls0
        (de0:tdecls@(_:de1:d2:_)) = decls
        de0' = setEntryDP de0 (DifferentLine 2 0)
        de1' = setEntryDP de1 (DifferentLine 2 0)
        d2' = setEntryDP d2 (DifferentLine 2 0)
        decls' = d2':de1':de0':tdecls
    debugM $ "changeWhereIn3b:de1':" ++ showAst de1'
    let p2 = p { hsmodDecls = decls'}
    return (L l p2)
  
  -- ---------------------------------------------------------------------
  
  addLocaLDecl1 :: Changer
  addLocaLDecl1 libdir top = do
    Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
    let decl' = setEntryDP (L ld decl) (DifferentLine 1 5)
        doAddLocal :: ParsedSource
        doAddLocal = replaceDecls lp [de1', d2', d3]
          where
            lp = top
            (de1:d2:d3:_) = hsDecls lp
            (de1'',d2') = balanceComments de1 d2
            (de1',_) = modifyValD (getLocA de1'') de1'' $ \_m d -> ((wrapDecl decl' : d),Nothing)
  
    let lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  
  addLocaLDecl2 :: Changer
  addLocaLDecl2 libdir lp = do
    Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
    let
        doAddLocal = replaceDecls lp [parent',d2']
          where
           (de1:d2:_) = hsDecls lp
           (de1'',d2') = balanceComments de1 d2
  
           (parent',_) = modifyValD (getLocA de1) de1'' $ \_m (d:ds) ->
               let
                 newDecl' = transferEntryDP' d (makeDeltaAst newDecl)
                 d' = setEntryDP d (DifferentLine 1 0)
               in ((newDecl':d':ds),Nothing)
  
  
        lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addLocaLDecl3 :: Changer
  addLocaLDecl3 libdir top = do
    Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
    let
        doAddLocal = replaceDecls (anchorEof lp) [parent',d2']
          where
           lp = top
           (de1:d2:_) = hsDecls lp
           (de1'',d2') = balanceComments de1 d2
  
           (parent',_) = modifyValD (getLocA de1) de1'' $ \_m (d:ds) ->
             let
               newDecl' = setEntryDP newDecl (DifferentLine 1 0)
             in (((d:ds) ++ [newDecl']),Nothing)
  
        lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addLocaLDecl4 :: Changer
  addLocaLDecl4 libdir lp = do
    Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
    Right newSig  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")
    let
        doAddLocal = replaceDecls (anchorEof lp) (parent':ds)
          where
            (parent:ds) = hsDecls (makeDeltaAst lp)
  
            newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 0)
            newSig'  = setEntryDP (makeDeltaAst newSig)  (DifferentLine 1 5)
  
            (parent',_) = modifyValD (getLocA parent) parent $ \_m decls ->
                           ((decls++[newSig',newDecl']),Nothing)
  
  
        lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addLocaLDecl5 :: Changer
  addLocaLDecl5 _libdir lp = do
    let
        doAddLocal = replaceDecls lp [s1,de1',d3']
          where
            decls = hsDecls lp
            [s1,de1,d2,d3] = balanceCommentsList decls
  
            d3' = setEntryDP d3 (DifferentLine 2 0)
  
            (de1',_) = modifyValD (getLocA de1) de1 $ \_m _decls ->
                         let
                           d2' = setEntryDP d2 (DifferentLine 1 0)
                         in ([d2'],Nothing)
  
        lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addLocaLDecl6 :: Changer
  addLocaLDecl6 libdir lp = do
    Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3")
    let
        newDecl' = setEntryDP (makeDeltaAst newDecl) (DifferentLine 1 5)
        doAddLocal = replaceDecls lp [de1', d2]
          where
            decls0 = hsDecls lp
            [de1'',d2] = balanceCommentsList decls0
  
            de1 = captureMatchLineSpacing de1''
            L _ (ValD _ (FunBind _ _ (MG _ (L _ ms)))) = de1
            [ma1,_ma2] = ms
  
            (de1',_) = modifyValD (getLocA ma1) de1 $ \_m decls ->
                         ((newDecl' : decls),Nothing)
  
        lp' = doAddLocal
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl1 :: Changer
  rmDecl1 _libdir lp = do
    let
        doRmDecl = replaceDecls lp (de1:d3':ds)
          where
            tlDecs0 = hsDecls lp
            tlDecs = balanceCommentsList tlDecs0
            (de1:_s1:_d2:d3:ds) = tlDecs
            d3' = setEntryDP d3 (DifferentLine 2 0)
  
  
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl2 :: Changer
  rmDecl2 _libdir lp = do
    let
        doRmDecl = do
          let
            go :: GHC.LHsExpr GhcPs -> Transform (GHC.LHsExpr GhcPs)
            go e@(GHC.L _ (GHC.HsLet{})) = do
              let decs0 = hsDecls e
              let decs = balanceCommentsList $ captureLineSpacing decs0
              let e' = replaceDecls e (init decs)
              return e'
            go x = return x
  
          everywhereM (mkM go) (makeDeltaAst lp)
  
    let (lp',_,_w) = runTransform doRmDecl
    debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl3 :: Changer
  rmDecl3 _libdir lp = do
    let
        doRmDecl = replaceDecls lp [de1',sd1,d2]
          where
            [de1,d2] = hsDecls lp
            (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1a] ->
                         let
                             sd1' = setEntryDP sd1a (DifferentLine 2 0)
                         in ([],Just sd1')
  
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl4 :: Changer
  rmDecl4 _libdir lp = do
    let
        doRmDecl = replaceDecls (anchorEof lp) [de1',sd1]
          where
           [de1] = hsDecls lp
           (de1',Just sd1) = modifyValD (getLocA de1) de1 $ \_m [sd1a,sd2] ->
             let
               sd2' = transferEntryDP' sd1a sd2
               sd1' = setEntryDP sd1a (DifferentLine 2 0)
             in ([sd2'],Just sd1')
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl5 :: Changer
  rmDecl5 _libdir lp = do
    let
        doRmDecl = do
          let
            go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
            go (HsLet (tkLet, tkIn) lb expr) = do
              let decs = hsDeclsLocalBinds lb
              let dec = last decs
              let lb' = replaceDeclsValbinds WithoutWhere lb [dec]
              return (HsLet (tkLet, tkIn) lb' expr)
            go x = return x
  
          everywhereM (mkM go) lp
  
    let (lp',_,_w) = runTransform doRmDecl
    debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl6 :: Changer
  rmDecl6 _libdir lp = do
    let
        doRmDecl = replaceDecls lp [de1']
          where
            [de1] = hsDecls lp
  
            (de1',_) = modifyValD (getLocA de1) de1 $ \_m subDecs ->
              let
                subDecs' = captureLineSpacing subDecs
                (ss1:_sd1:sd2:sds) = subDecs'
                sd2' = transferEntryDP' ss1 sd2
              in (sd2':sds,Nothing)
  
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmDecl7 :: Changer
  rmDecl7 _libdir lp = do
    let
        doRmDecl = replaceDecls lp [s1,de1,d3']
          where
            tlDecs = hsDecls lp
            [s1,de1,d2,d3] = balanceCommentsList tlDecs
            d3' = transferEntryDP' d2 d3
  
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmTypeSig1 :: Changer
  rmTypeSig1 _libdir lp = do
    let doRmDecl = replaceDecls lp (s1':de1:d2)
          where
            tlDecs = hsDecls lp
            (s0:de1:d2) = tlDecs
            s1 = captureTypeSigSpacing s0
            (L l (SigD x1 (TypeSig x2 [n1,n2] typ))) = s1
            L ln n2' = transferEntryDP n1 n2
            s1' = (L l (SigD x1 (TypeSig x2 [L (noTrailingN ln) n2'] typ)))
  
        lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  rmTypeSig2 :: Changer
  rmTypeSig2 _libdir lp = do
    let doRmDecl = replaceDecls lp [de1']
          where
            tlDecs = hsDecls lp
            [de1] = tlDecs
            (de1',_) = modifyValD (getLocA de1) de1 $ \_m [_s,d] -> ([d],Nothing)
  
    let lp' = doRmDecl
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addHiding1 :: Changer
  addHiding1 _libdir (L l p) = do
    let doTransform = do
          let
            [L li imp1,imp2] = hsmodImports p
            n1 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n1"))
            n2 = L noAnnSrcSpanDP0 (mkVarUnqual (mkFastString "n2"))
            v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)
            v2 = L (           noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)
            impHiding = L (EpAnn d0
                                 (AnnList Nothing
                                          (ListParens (EpTok d1) (EpTok d0))
                                          []
                                          (EpTok d1,[])
                                          [])
                                   emptyComments) [v1,v2]
            imp1' = imp1 { ideclImportList = Just (EverythingBut,impHiding)}
            imp2' = setEntryDP imp2 (DifferentLine 2 0)
            p' = p { hsmodImports = [L li imp1',imp2']}
          return (L l p')
  
    let (lp',_,_w) = runTransform doTransform
    debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addHiding2 :: Changer
  addHiding2 _libdir top = do
    let doTransform = do
          let (L l p) = top
          let
            [L li imp1] = hsmodImports p
            Just (_,L _lh ns) = ideclImportList imp1
            lh' = (EpAnn d0
                         (AnnList Nothing
                                  (ListParens (EpTok d1) (EpTok d0))
                                  []
                                  (EpTok d1, [])
                                  [])
                           emptyComments)
            n1 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n1"))
            n2 = L (noAnnSrcSpanDP0) (mkVarUnqual (mkFastString "n2"))
            v1 = L (addComma $ noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n1)) Nothing)
            v2 = L (           noAnnSrcSpanDP0) (IEVar Nothing (L noAnnSrcSpanDP0 (IEName noExtField n2)) Nothing)
            L ln n = last ns
            n' = L (addComma ln) n
            imp1' = imp1 { ideclImportList = Just (EverythingBut, L lh' (init ns ++ [n',v1,v2]))}
            p' = p { hsmodImports = [L li imp1']}
          return (L l p')
  
    let (lp',_,_w) = runTransform doTransform
    debugM $ "log:[\n" ++ intercalate "\n" _w ++ "]log end\n"
    return lp'
  
  -- ---------------------------------------------------------------------
  
  addClassMethod :: Changer
  addClassMethod libdir lp = do
    Right sig  <- withDynFlags libdir (\df -> parseDecl df "sig"  "nn :: Int")
    Right decl <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2")
    let decl' = setEntryDP decl (DifferentLine 1 2)
    let  sig' = setEntryDP sig  (DifferentLine 2 2)
    let doAddMethod = do
          let
            [cd] = hsDecls lp
            (f1:f2s:f2d:_) = hsDecls cd
            f2s' = setEntryDP f2s  (DifferentLine 2 2)
            cd' = replaceDecls cd [f1, sig', decl', f2s', f2d]
            lp' = replaceDecls lp [cd']
          return lp'
  
    let (lp',_,w) = runTransform doAddMethod
    debugM $ "addClassMethod:" ++ intercalate "\n" w
    return 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
  
  -- ---------------------------------------------------------------------
  