From 3de6fe2e619a262c526d336da99e3e97b189d1e1 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Mon, 9 Jan 2023 17:58:26 +0000
Subject: WIP

---
 utils/check-exact/ExactPrint.hs | 10 +++++++---
 utils/check-exact/Main.hs       | 21 ++++++++++++---------
 utils/haddock                   |  2 +-
 3 files changed, 20 insertions(+), 13 deletions(-)

diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 0124bf46b6..0c3086bcb1 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1385,10 +1385,14 @@ markTopLevelList ls = mapM (\a -> setLayoutTopLevelP $ markAnnotated a) ls
 instance (ExactPrint a) => ExactPrint (Located a) where
   getAnnotationEntry (L l _) = case l of
     UnhelpfulSpan _ -> NoEntryVal
-    _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly
+    _ -> Entry (spanAsAnchor l) emptyComments NoFlushComments NoCanUpdateAnchor
+  -- getAnnotationEntry (L l _) = case l of
+  --   UnhelpfulSpan _ -> NoEntryVal
+  --   _ -> Entry (hackSrcSpanToAnchor l) emptyComments NoFlushComments CanUpdateAnchorOnly
 
-  setAnnotationAnchor (L _ a) anc _cs = (L (hackAnchorToSrcSpan anc) a)
-                 `debug` ("setAnnotationAnchor(Located):" ++ showAst anc)
+  -- setAnnotationAnchor (L _ a) anc _cs = (L (hackAnchorToSrcSpan anc) a)
+  --                `debug` ("setAnnotationAnchor(Located):" ++ showAst anc)
+  setAnnotationAnchor ls _ _ = ls
 
   exact (L l a) = L l <$> markAnnotated a
 
diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs
index 6bb552b3c8..0d5f9371c4 100644
--- a/utils/check-exact/Main.hs
+++ b/utils/check-exact/Main.hs
@@ -54,7 +54,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/epw/_buil
  -- "../../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/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)
@@ -304,7 +304,8 @@ testOneFile _ libdir fileName mchanger = do
 
        (changedSourceOk, expectedSource, changedSource) <- case mchanger of
          Just changer -> do
-           (pped', ast') <- exactprintWithChange libdir changer p
+           let changer' = changer `debug` ("****Starting to run changer****")
+           (pped', ast') <- exactprintWithChange libdir changer' p
            writeBinFile changedAstFile (ppAst ast')
            writeBinFile newFileChanged pped'
 
@@ -461,8 +462,7 @@ 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
+  let (p',_,_) = runTransform (replaceTopLevelDecls top)
       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
       replaceTopLevelDecls m = insertAtStart m decl'
   return p'
@@ -472,10 +472,10 @@ changeAddDecl1 libdir top = do
 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 decl' = setEntryDP decl (DifferentLine 2 0)
 
   let (p',_,_) = runTransform doAddDecl
-      doAddDecl = everywhereM (mkM replaceTopLevelDecls) (makeDeltaAst top)
+      doAddDecl = everywhereM (mkM replaceTopLevelDecls) top
       replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource
       replaceTopLevelDecls m = insertAtEnd m decl'
   return p'
@@ -590,12 +590,14 @@ 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 = do
-        let lp = makeDeltaAst top
+        -- let lp = makeDeltaAst top
+        let lp = top
         (de1:d2:d3:_) <- hsDecls lp
         (de1'',d2') <- balanceComments de1 d2
+        let d2'' = setEntryDP d2' (DifferentLine 2 0)
         (de1',_) <- modifyValD (getLocA de1'') de1'' $ \_m d -> do
           return ((wrapDecl decl' : d),Nothing)
-        replaceDecls lp [de1', d2', d3]
+        replaceDecls lp [de1', d2'', d3]
 
   (lp',_,w) <- runTransformT doAddLocal
   debugM $ "addLocaLDecl1:" ++ intercalate "\n" w
@@ -902,7 +904,8 @@ addHiding1 _libdir (L l p) = do
                                               [])
                                        emptyComments) l0) [v1,v2]
           imp1' = imp1 { ideclImportList = Just (EverythingBut,impHiding)}
-          p' = p { hsmodImports = [L li imp1',imp2]}
+          imp2' = setEntryDP imp2 (DifferentLine 2 0)
+          p' = p { hsmodImports = [L li imp1',imp2']}
         return (L l p')
 
   let (lp',_,_w) = runTransform doTransform
diff --git a/utils/haddock b/utils/haddock
index 261a7c8ac5..519a95998b 160000
--- a/utils/haddock
+++ b/utils/haddock
@@ -1 +1 @@
-Subproject commit 261a7c8ac5b5ff29e6e0380690cbb6ee9730f985
+Subproject commit 519a95998b09a2c9c7a42c3a0cf2ca0c4358bb49
-- 
cgit v1.2.1