From 21abedfd3e7128a571aa406784b1c7634be5b40d Mon Sep 17 00:00:00 2001
From: Ziyang Liu <unsafeFixIO@gmail.com>
Date: Sun, 13 Sep 2020 21:11:45 -0700
Subject: [PATCH 1/2] Sort comments properly, ignoring SrcSpan's file

---
 src/Language/Haskell/GHC/ExactPrint/Delta.hs   | 14 ++++++++++----
 src/Language/Haskell/GHC/ExactPrint/Parsers.hs |  4 ++--
 tests/Test/Common.hs                           |  2 +-
 3 files changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/Language/Haskell/GHC/ExactPrint/Delta.hs b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
index 0e78b4b2..801091f1 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Delta.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Delta.hs
@@ -129,7 +129,7 @@ import Control.Monad.RWS
 import Control.Monad.Trans.Free
 
 import Data.Data (Data)
-import Data.List (sort, nub, partition, sortBy)
+import Data.List (sort, nub, partition, sortBy, sortOn)
 
 import Data.Ord
 
@@ -746,8 +746,15 @@ commentAllocation p k = do
   cs <- getUnallocatedComments
   let (allocated,cs') = allocateComments p cs
   putUnallocatedComments cs'
-  k =<< mapM makeDeltaComment (sortBy (comparing commentIdentifier) allocated)
-
+  k =<< mapM makeDeltaComment (sortOn (unpack . commentIdentifier) allocated)
+  where
+    -- unpack a RealSrcSpan into ((start line, start col), (end line, end col)).
+    -- The file name is ignored.
+    unpack :: GHC.SrcSpan -> Maybe ((Int, Int), (Int, Int))
+    unpack (GHC.RealSrcSpan x) =
+       Just ( (GHC.srcSpanStartLine x, GHC.srcSpanStartCol x)
+            , (GHC.srcSpanEndLine x, GHC.srcSpanEndCol x) )
+    unpack _ = Nothing
 
 makeDeltaComment :: Comment -> Delta (Comment, DeltaPos)
 makeDeltaComment c = do
@@ -875,4 +882,3 @@ countAnnsDelta :: GHC.AnnKeywordId -> Delta Int
 countAnnsDelta ann = do
   ma <- peekAnnotationDelta ann
   return (length ma)
-
diff --git a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
index 2d656659..68090504 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Parsers.hs
@@ -338,10 +338,10 @@ postParseTransform
   :: Either a (GHC.ApiAnns, [Comment], GHC.DynFlags, GHC.ParsedSource)
   -> DeltaOptions
   -> Either a (Anns, GHC.ParsedSource)
-postParseTransform parseRes opts = either Left mkAnns parseRes
+postParseTransform parseRes opts = fmap mkAnns parseRes
   where
     mkAnns (apianns, cs, _, m) =
-      Right (relativiseApiAnnsWithOptions opts cs m apianns, m)
+      (relativiseApiAnnsWithOptions opts cs m apianns, m)
 
 -- | Internal function. Initializes DynFlags value for parsing.
 --
diff --git a/tests/Test/Common.hs b/tests/Test/Common.hs
index f6680214..c465e894 100644
--- a/tests/Test/Common.hs
+++ b/tests/Test/Common.hs
@@ -63,7 +63,7 @@ import System.FilePath
 
 -- import Debug.Trace
 testPrefix :: FilePath
-testPrefix = "tests" </> "examples"
+testPrefix = "." </> "tests" </> "examples"
 
 testList :: String -> [Test] -> Test
 testList s ts = TestLabel s (TestList ts)

From be076f621f6ae7feff7ff45c6d5e70ac17833f78 Mon Sep 17 00:00:00 2001
From: Ziyang Liu <unsafeFixIO@gmail.com>
Date: Sun, 13 Sep 2020 22:18:16 -0700
Subject: [PATCH 2/2] Fix a failing test for GHC 8.2

---
 tests/examples/failing/overloadedlabelsrun04.hs.bad | 10 ++--------
 1 file changed, 2 insertions(+), 8 deletions(-)

diff --git a/tests/examples/failing/overloadedlabelsrun04.hs.bad b/tests/examples/failing/overloadedlabelsrun04.hs.bad
index 18f320f9..09fd81e0 100644
--- a/tests/examples/failing/overloadedlabelsrun04.hs.bad
+++ b/tests/examples/failing/overloadedlabelsrun04.hs.bad
@@ -2,17 +2,11 @@
 
 import OverloadedLabelsRun04_A
 
-
-
+-- Who knew that there were so many ways that a line could start with
+-- a # sign in Haskell? None of these are overloaded labels:
 
 
 #!notashellscript
 
 -- But this one is:
--- a # sign in Haskell? None of these are overloaded labels:
-
-
-
-
-
 #foo