From 1f186d7e9c218af08effcd216e99b27e955c0a5a Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Thu, 9 May 2024 20:59:31 +0100
Subject: [PATCH] Final GHC 9.10.1 pre-release roundtrip

Successful
---
 roundtrip-config/knownfailures.txt           |  2 ++
 src/Language/Haskell/GHC/ExactPrint/Utils.hs | 21 +++++++++++---------
 tests/Test.hs                                |  2 ++
 3 files changed, 16 insertions(+), 9 deletions(-)

diff --git a/roundtrip-config/knownfailures.txt b/roundtrip-config/knownfailures.txt
index 7898b2b7..c97da583 100644
--- a/roundtrip-config/knownfailures.txt
+++ b/roundtrip-config/knownfailures.txt
@@ -211,3 +211,5 @@
 ./hackage-roundtrip-work/willow-0.1.0.0/test/Test/Willow/WebPlatformTests/Manual/Encoding.hs
 ./hackage-roundtrip-work/yesod-goodies-0.0.5/Yesod/Goodies/Markdown.hs
 ./hackage-roundtrip-work/MissingH-1.6.0.1/src/System/IO/WindowsCompat.hs
+./hackage-roundtrip-work/fudgets-0.18.4/hsrc/ghc-dialogue/P_IO_data.hs
+./hackage-roundtrip-work/MagicHaskeller-0.9.7.1/MagicHaskeller/ExecuteAPI610.hs
diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
index b0078dd6..81bc60e6 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
@@ -267,7 +267,7 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining
     p0 = p { hsmodExt = (hsmodExt p) { hsmodAnn = EpAnn anct ant emptyComments }}
     -- Comments embedded within spans
     -- everywhereM is a bottom-up traversal
-    (p1, toplevel) = runState (everywhereM (mkM    addCommentsListItem
+    (p1, toplevel) = runState (everywhereM (mkM   addCommentsListItem
                                            `extM` addCommentsGrhs
                                            `extM` addCommentsList) p0) cs
     (p2, remaining) = insertTopLevelCppComments p1 toplevel
@@ -281,8 +281,8 @@ insertCppComments (L l p) cs0 = insertRemainingCppComments (L l p2) remaining
     addCommentsGrhs :: EpAnn GrhsAnn -> State [LEpaComment] (EpAnn GrhsAnn)
     addCommentsGrhs = addComments
 
-    addComments :: forall ann. String -> EpAnn ann -> State [LEpaComment] (EpAnn ann)
-    addComments ctx (EpAnn anc an ocs) = do
+    addComments :: forall ann. EpAnn ann -> State [LEpaComment] (EpAnn ann)
+    addComments (EpAnn anc an ocs) = do
       case anc of
         EpaSpan (RealSrcSpan s _) -> do
           unAllocated <- get
@@ -313,7 +313,7 @@ insertTopLevelCppComments ::  HsModule GhcPs -> [LEpaComment] -> (HsModule GhcPs
 insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports imports decls) cs
   = (HsModule (XModulePs an4 lo mdeprec mbDoc) mmn mexports' imports' decls', cs3)
     -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0,hc1,hc_cs))
-    `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs))
+    -- `debug` ("insertTopLevelCppComments: (cs2,cs3,hc0i,hc0,hc1,hc_cs)" ++ showAst (cs2,cs3,hc0i,hc0,hc1,hc_cs))
   where
     -- Comments at the top level.
     (an0, cs0) =
@@ -322,7 +322,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
         Just _ ->
             -- We have a module name. Capture all comments up to the `where`
             let
-              (remaining, these) = splitOnWhere (<) (am_main $ anns an) cs
+              (these, remaining) = splitOnWhere Before (am_main $ anns an) cs
               (EpAnn a anno ocs) = an :: EpAnn AnnsModule
               anm = EpAnn a anno (workInComments ocs these)
             in
@@ -368,7 +368,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
 
     (hc1,hc_cs) = if null ( am_main $ anns an3)
         then (hc0,[])
-        else splitOnWhere (>) (am_main $ anns an3)  hc0
+        else splitOnWhere After (am_main $ anns an3)  hc0
     hc2 = workInComments (comments an3) hc1
     an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 }
 
@@ -384,11 +384,14 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
         cs4' = workInComments cs4 these
         (xs',rest') = allocPreceding xs rest
 
-splitOnWhere :: (Pos -> Pos -> Bool) -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
+data SplitWhere = Before | After
+splitOnWhere :: SplitWhere -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
 splitOnWhere _ [] csIn = (csIn,[])
-splitOnWhere f (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)
+splitOnWhere w (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)
   where
-    (hc,fc) = break (\(L ll _) ->  f (ss2pos $ anchor ll) (ss2pos s)) csIn
+    splitFunc Before anc_pos c_pos = c_pos < anc_pos
+    splitFunc After  anc_pos c_pos = anc_pos < c_pos
+    (hc,fc) = break (\(L ll _) ->  splitFunc w (ss2pos $ anchor ll) (ss2pos s)) csIn
 splitOnWhere _ (AddEpAnn AnnWhere _:_) csIn = (csIn, [])
 splitOnWhere f (_:as) csIn = splitOnWhere f as csIn
 
diff --git a/tests/Test.hs b/tests/Test.hs
index 96009bec..019e650a 100644
--- a/tests/Test.hs
+++ b/tests/Test.hs
@@ -202,6 +202,8 @@ tt' = do
     -- mkParserTest libdir "ghc910" "Expression.hs"
     -- mkParserTest libdir "ghc910" "ConstructorArgs.hs"
     mkParserTest libdir "ghc910" "CppComment.hs"
+    -- mkParserTest libdir "ghc910" "Class.hs"
+    -- mkParserTest libdir "ghc910" "Test138.hs"
 
    -- Needs GHC changes