Factor out the ‘isModule’ function and the use of module span

Module span is dummy and misleading. Right now it is not used at all, but we
still organize code as if it were used.

src/GHC.hs

@@ -1,6 +1,5 @@
 module GHC
   ( module X,
-    ParsedSource,
   )
 where
 
@@ -11,5 +10,3 @@ import GHC.Hs.Instances as X ()
 import Module as X
 import RdrName as X
 import SrcLoc as X
-
-type ParsedSource = Located (HsModule GhcPs)

src/Ormolu/Diff.hs

@@ -38,14 +38,16 @@ diffParseResult :: ParseResult -> ParseResult -> Diff
 diffParseResult
   ParseResult
     { prCommentStream = cstream0,
-      prParsedSource = ps0
+      prParsedSource = hs0
     }
   ParseResult
     { prCommentStream = cstream1,
-      prParsedSource = ps1
+      prParsedSource = hs1
     } =
     matchIgnoringSrcSpans cstream0 cstream1
-      <> matchIgnoringSrcSpans ps0 ps1
+      <> matchIgnoringSrcSpans
+        hs0 {hsmodImports = sortImports (hsmodImports hs0)}
+        hs1 {hsmodImports = sortImports (hsmodImports hs1)}
 
 -- | Compare two values for equality disregarding differences in 'SrcSpan's
 -- and the ordering of import lists.
@@ -67,7 +69,6 @@ matchIgnoringSrcSpans = genericQuery
           gzipWithQ
             ( genericQuery
                 `extQ` srcSpanEq
-                `extQ` hsModuleEq
                 `extQ` sourceTextEq
                 `extQ` hsDocStringEq
                 `extQ` importDeclQualifiedStyleEq
@@ -78,14 +79,6 @@ matchIgnoringSrcSpans = genericQuery
       | otherwise = Different []
     srcSpanEq :: SrcSpan -> GenericQ Diff
     srcSpanEq _ _ = Same
-    hsModuleEq :: HsModule GhcPs -> GenericQ Diff
-    hsModuleEq hs0 hs1' =
-      case cast hs1' :: Maybe (HsModule GhcPs) of
-        Nothing -> Different []
-        Just hs1 ->
-          matchIgnoringSrcSpans
-            hs0 {hsmodImports = sortImports (hsmodImports hs0)}
-            hs1 {hsmodImports = sortImports (hsmodImports hs1)}
     sourceTextEq :: SourceText -> GenericQ Diff
     sourceTextEq _ _ = Same
     importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff

src/Ormolu/Parser.hs

@@ -88,7 +88,7 @@ parseModule Config {..} path rawInput = liftIO $ do
           case pStateErrors pstate of
             Just err -> Left err
             Nothing -> error "PFailed does not have an error"
-        GHC.POk pstate pmod ->
+        GHC.POk pstate (L _ hsModule) ->
           case pStateErrors pstate of
             -- Some parse errors (pattern/arrow syntax in expr context)
             -- do not cause a parse error, but they are replaced with "_"
@@ -100,7 +100,7 @@ parseModule Config {..} path rawInput = liftIO $ do
                     mkCommentStream extraComments pstate
                in Right
                     ParseResult
-                      { prParsedSource = pmod,
+                      { prParsedSource = hsModule,
                         prAnns = mkAnns pstate,
                         prStackHeader = stackHeader,
                         prShebangs = shebangs,

src/Ormolu/Parser/Result.hs

@@ -17,7 +17,7 @@ import Ormolu.Parser.Shebang (Shebang)
 -- | A collection of data that represents a parsed module in Ormolu.
 data ParseResult = ParseResult
   { -- | 'ParsedSource' from GHC
-    prParsedSource :: ParsedSource,
+    prParsedSource :: HsModule GhcPs,
     -- | Ormolu-specfic representation of annotations
     prAnns :: Anns,
     -- | Stack header

src/Ormolu/Printer/Combinators.hs

@@ -62,12 +62,10 @@ module Ormolu.Printer.Combinators
 where
 
 import Control.Monad
-import Data.Data (Data)
 import Data.List (intersperse)
 import Data.Text (Text)
 import Ormolu.Printer.Comments
 import Ormolu.Printer.Internal
-import Ormolu.Utils (isModule)
 import SrcLoc
 
 ----------------------------------------------------------------------------
@@ -79,31 +77,20 @@ import SrcLoc
 -- 'Located' wrapper, it should be “discharged” with a corresponding
 -- 'located' invocation.
 located ::
-  Data a =>
   -- | Thing to enter
   Located a ->
   -- | How to render inner value
   (a -> R ()) ->
   R ()
-located loc f = do
-  let withRealLocated (L l a) g =
-        case l of
-          UnhelpfulSpan _ -> return ()
-          RealSrcSpan l' -> g (L l' a)
-  withRealLocated loc spitPrecedingComments
-  let setEnclosingSpan =
-        case getLoc loc of
-          UnhelpfulSpan _ -> id
-          RealSrcSpan orf ->
-            if isModule (unLoc loc)
-              then id
-              else withEnclosingSpan orf
-  setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))
-  withRealLocated loc spitFollowingComments
+located (L (UnhelpfulSpan _) a) f = f a
+located (L (RealSrcSpan l) a) f = do
+  spitPrecedingComments l
+  withEnclosingSpan l $
+    switchLayout [RealSrcSpan l] (f a)
+  spitFollowingComments l
 
 -- | A version of 'located' with arguments flipped.
 located' ::
-  Data a =>
   -- | How to render inner value
   (a -> R ()) ->
   -- | Thing to enter

src/Ormolu/Printer/Comments.hs

@@ -14,12 +14,10 @@ where
 
 import Control.Monad
 import Data.Coerce (coerce)
-import Data.Data (Data)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Text as T
 import Ormolu.Parser.CommentStream
 import Ormolu.Printer.Internal
-import Ormolu.Utils (isModule)
 import SrcLoc
 
 ----------------------------------------------------------------------------
@@ -27,9 +25,8 @@ import SrcLoc
 
 -- | Output all preceding comments for an element at given location.
 spitPrecedingComments ::
-  Data a =>
-  -- | AST element to attach comments to
-  RealLocated a ->
+  -- | Span of the element to attach comments to
+  RealSrcSpan ->
   R ()
 spitPrecedingComments ref = do
   gotSome <- handleCommentSeries (spitPrecedingComment ref)
@@ -37,16 +34,15 @@ spitPrecedingComments ref = do
     lastMark <- getSpanMark
     -- Insert a blank line between the preceding comments and the thing
     -- after them if there was a blank line in the input.
-    when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline
+    when (needsNewlineBefore ref lastMark) newline
 
 -- | Output all comments following an element at given location.
 spitFollowingComments ::
-  Data a =>
-  -- | AST element of attach comments to
-  RealLocated a ->
+  -- | Span of the element to attach comments to
+  RealSrcSpan ->
   R ()
 spitFollowingComments ref = do
-  trimSpanStream (getRealSrcSpan ref)
+  trimSpanStream ref
   void $ handleCommentSeries (spitFollowingComment ref)
 
 -- | Output all remaining comments in the comment stream.
@@ -62,14 +58,13 @@ spitRemainingComments = do
 
 -- | Output a single preceding comment for an element at given location.
 spitPrecedingComment ::
-  Data a =>
-  -- | AST element to attach comments to
-  RealLocated a ->
+  -- | Span of the element to attach comments to
+  RealSrcSpan ->
   -- | Location of last comment in the series
   Maybe SpanMark ->
   -- | Are we done?
   R Bool
-spitPrecedingComment (L ref a) mlastMark = do
+spitPrecedingComment ref mlastMark = do
   let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
   withPoppedComment p $ \l comment -> do
     dirtyLine <-
@@ -80,31 +75,33 @@ spitPrecedingComment (L ref a) mlastMark = do
         -- immediately because it'll be attached to the previous element (on
         -- the same line) on the next run, so we play safe here and output
         -- an extra 'newline' in this case.
-        Nothing -> isLineDirty -- only for very first preceding comment
+        --
+        -- We check 'mlastMark' to do this only for the very first preceding
+        -- comment.
         Just _ -> return False
+        _ -> isLineDirty
     when (dirtyLine || needsNewlineBefore l mlastMark) newline
     spitCommentNow l comment
-    if theSameLinePre l ref && not (isModule a)
+    if theSameLinePre l ref
       then space
       else newline
 
 -- | Output a comment that follows element at given location immediately on
 -- the same line, if there is any.
 spitFollowingComment ::
-  Data a =>
   -- | AST element to attach comments to
-  RealLocated a ->
+  RealSrcSpan ->
   -- | Location of last comment in the series
   Maybe SpanMark ->
   -- | Are we done?
   R Bool
-spitFollowingComment (L ref a) mlastMark = do
+spitFollowingComment ref mlastMark = do
   mnSpn <- nextEltSpan
   -- Get first enclosing span that is not equal to reference span, i.e. it's
   -- truly something enclosing the AST element.
   meSpn <- getEnclosingSpan (/= ref)
   withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->
-    if theSameLinePost l ref && not (isModule a)
+    if theSameLinePost l ref
       then
         if isMultilineComment comment
           then space >> spitCommentNow l comment

src/Ormolu/Printer/Meat/Module.hs

@@ -34,9 +34,9 @@ p_hsModule ::
   -- | Whether to use postfix qualified imports
   Bool ->
   -- | AST to print
-  ParsedSource ->
+  HsModule GhcPs ->
   R ()
-p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do
+p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do
   let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage
       exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports
   switchLayout (deprecSpan <> exportSpans) $ do

src/Ormolu/Utils.hs

@@ -6,7 +6,6 @@ module Ormolu.Utils
   ( RelativePos (..),
     attachRelativePos,
     combineSrcSpans',
-    isModule,
     notImplemented,
     showOutputable,
     splitDocString,
@@ -18,7 +17,6 @@ module Ormolu.Utils
   )
 where
 
-import Data.Data (Data, showConstr, toConstr)
 import Data.List (dropWhileEnd)
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty (..))
@@ -52,10 +50,6 @@ attachRelativePos = \case
 combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan
 combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs
 
--- | Return 'True' if given element of AST is module.
-isModule :: Data a => a -> Bool
-isModule x = showConstr (toConstr x) == "HsModule"
-
 -- | Placeholder for things that are not yet implemented.
 notImplemented :: String -> a
 notImplemented msg = error $ "not implemented yet: " ++ msg