Sort comments properly, ignoring SrcSpan's file

alanz · Sep 14, 2020 · 21abedf · 21abedf
1 parent ff436e7
commit 21abedf
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 7 deletions.
diff --git 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
@@ -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
@@ -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)