Fix printing comments between module name and 'where'

alanz · May 5, 2024 · 1aa9d13 · 1aa9d13
1 parent 166cbdb
commit 1aa9d13
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 23 deletions.
diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
@@ -313,12 +313,17 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
       case mmn of
         Nothing -> (an, cs)
         Just (L l _) ->
+            -- We have a module name. Capture all comments up to the `where`
+            -- if no exports
             let
               (remaining, these) =
-                case entry l of
-                  EpaSpan (RealSrcSpan s _) -> do
-                      allocatePriorComments (ss2posEnd s) cs
-                  _ -> (cs, [])
+                case mexports of
+                  Just _ ->
+                    case entry l of
+                      EpaSpan (RealSrcSpan s _) -> do
+                          allocatePriorComments (ss2posEnd s) cs
+                      _ -> (cs, [])
+                  Nothing -> splitOnWhere (<) (am_main $ anns an) cs
 
               (EpAnn a anno ocs) = an :: EpAnn AnnsModule
               anm = EpAnn a anno (workInComments ocs these)
@@ -365,7 +370,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 (>) (am_main $ anns an3)  hc0
     hc2 = workInComments (comments an3) hc1
     an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 }
 
@@ -381,13 +386,13 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports
         cs4' = workInComments cs4 these
         (xs',rest') = allocPreceding xs rest
 
-splitOnWhere :: [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
-splitOnWhere [] csIn = (csIn,[])
-splitOnWhere (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)
+splitOnWhere :: (Pos -> Pos -> Bool) -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment])
+splitOnWhere _ [] csIn = (csIn,[])
+splitOnWhere f (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc)
   where
-    (hc,fc) = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) ) csIn
-splitOnWhere (AddEpAnn AnnWhere _:_) csIn = (csIn, [])
-splitOnWhere (_:as) csIn = splitOnWhere as csIn
+    (hc,fc) = break (\(L ll _) ->  f (ss2pos $ anchor ll) (ss2pos s)) csIn
+splitOnWhere _ (AddEpAnn AnnWhere _:_) csIn = (csIn, [])
+splitOnWhere f (_:as) csIn = splitOnWhere f as csIn
 
 balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment])
 balanceFirstLocatedAComments [] = ([],[])

diff --git a/tests/Test.hs b/tests/Test.hs
@@ -44,8 +44,8 @@ testDirs :: [FilePath]
 testDirs =
   case ghcVersion of
     GHC98  -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96"]
-    -- GHC910 -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96", "ghc98"]
-    GHC910  -> ["ghc910"]
+    GHC910 -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96", "ghc98"]
+    -- GHC910  -> ["ghc910"]
     -- GHC910  -> ["ghc910-copied"]
     -- GHC910  -> ["ghc910",  "ghc910-copied"]
 
@@ -142,13 +142,13 @@ mkTests = do
   return $ TestList [
                       internalTests,
                       roundTripTests
-                   -- ,
-                   --   (transformTests libdir)
-                   -- , (failingTests libdir)
-                   -- ,
-                   --   roundTripBalanceCommentsTests
-                   -- ,
-                   --   roundTripMakeDeltaTests
+                   ,
+                     (transformTests libdir)
+                   , (failingTests libdir)
+                   ,
+                     roundTripBalanceCommentsTests
+                   ,
+                     roundTripMakeDeltaTests
                     ]
 
 failingTests :: LibDir -> Test
@@ -200,9 +200,8 @@ tt' = do
     -- mkParserTest libdir "ghc910" "LinearLet.hs"
     -- mkParserTest libdir "ghc910" "Generic.hs"
     -- mkParserTest libdir "ghc910" "Expression.hs"
-    mkParserTest libdir "ghc910" "GenerateBug.hs"
     -- mkParserTest libdir "ghc910" "ConstructorArgs.hs"
-    -- mkParserTest libdir "ghc910" "T23927_2.hs"
+    mkParserTest libdir "ghc910" "P_IO_data.hs"
 
    -- Needs GHC changes
 

diff --git a/tests/examples/ghc910/P_IO_data.hs b/tests/examples/ghc910/P_IO_data.hs
@@ -1 +1 @@
-module P_IO_data {- comment -} where
+module P_IO_data {- c1 -} where