Clean up some stuff around comments

src/Ormolu/Parser/CommentStream.hs

@@ -10,6 +10,7 @@ module Ormolu.Parser.CommentStream
     showCommentStream,
 
     -- * Comment
+    LComment,
     Comment (..),
     unComment,
     hasAtomsBefore,
@@ -44,7 +45,7 @@ import Ormolu.Utils (onTheSameLine, showOutputable)
 
 -- | A stream of 'RealLocated' 'Comment's in ascending order with respect to
 -- beginning of corresponding spans.
-newtype CommentStream = CommentStream [RealLocated Comment]
+newtype CommentStream = CommentStream [LComment]
   deriving (Eq, Data, Semigroup, Monoid)
 
 -- | Create 'CommentStream' from 'HsModule'. The pragmas are
@@ -55,8 +56,8 @@ mkCommentStream ::
   -- | Module to use for comment extraction
   HsModule GhcPs ->
   -- | Stack header, pragmas, and comment stream
-  ( Maybe (RealLocated Comment),
-    [([RealLocated Comment], Pragma)],
+  ( Maybe LComment,
+    [([LComment], Pragma)],
     CommentStream
   )
 mkCommentStream input hsModule =
@@ -115,6 +116,8 @@ showCommentStream (CommentStream xs) =
 ----------------------------------------------------------------------------
 -- Comment
 
+type LComment = RealLocated Comment
+
 -- | A wrapper for a single comment. The 'Bool' indicates whether there were
 -- atoms before beginning of the comment in the original input. The
 -- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or
@@ -131,7 +134,7 @@ mkComment ::
   -- | Raw comment string
   RealLocated Text ->
   -- | Remaining lines of original input and the constructed 'Comment'
-  ([(Int, Text)], RealLocated Comment)
+  ([(Int, Text)], LComment)
 mkComment ls (L l s) = (ls', comment)
   where
     comment =
@@ -185,7 +188,7 @@ isMultilineComment (Comment _ (x :| _)) = "{-" `T.isPrefixOf` x
 extractStackHeader ::
   -- | Comment stream to analyze
   [RealLocated Text] ->
-  ([RealLocated Text], Maybe (RealLocated Comment))
+  ([RealLocated Text], Maybe LComment)
 extractStackHeader = \case
   [] -> ([], Nothing)
   (x : xs) ->
@@ -203,7 +206,7 @@ extractPragmas ::
   Text ->
   -- | Comment stream to analyze
   [RealLocated Text] ->
-  ([RealLocated Comment], [([RealLocated Comment], Pragma)])
+  ([LComment], [([LComment], Pragma)])
 extractPragmas input = go initialLs id id
   where
     initialLs = zip [1 ..] (T.lines input)

src/Ormolu/Parser/Result.hs

@@ -9,7 +9,6 @@ import Data.Text (Text)
 import GHC.Data.EnumSet (EnumSet)
 import GHC.Hs
 import GHC.LanguageExtensions.Type
-import GHC.Types.SrcLoc
 import Ormolu.Config (SourceType)
 import Ormolu.Fixity (ModuleFixityMap)
 import Ormolu.Parser.CommentStream
@@ -25,9 +24,9 @@ data ParseResult = ParseResult
     -- | Either regular module or signature file
     prSourceType :: SourceType,
     -- | Stack header
-    prStackHeader :: Maybe (RealLocated Comment),
+    prStackHeader :: Maybe LComment,
     -- | Pragmas and the associated comments
-    prPragmas :: [([RealLocated Comment], Pragma)],
+    prPragmas :: [([LComment], Pragma)],
     -- | Comment stream
     prCommentStream :: CommentStream,
     -- | Enabled extensions

src/Ormolu/Printer/Combinators.hs

@@ -10,6 +10,7 @@ module Ormolu.Printer.Combinators
     R,
     runR,
     getEnclosingSpan,
+    getEnclosingSpanWhere,
     isExtensionEnabled,
 
     -- * Combinators

src/Ormolu/Printer/Comments.hs

@@ -27,8 +27,8 @@ spitPrecedingComments ::
   RealSrcSpan ->
   R ()
 spitPrecedingComments ref = do
-  gotSome <- handleCommentSeries (spitPrecedingComment ref)
-  when gotSome $ do
+  comments <- handleCommentSeries (spitPrecedingComment ref)
+  when (not $ null comments) $ 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.
@@ -58,8 +58,8 @@ spitRemainingComments = do
 spitPrecedingComment ::
   -- | Span of the element to attach comments to
   RealSrcSpan ->
-  -- | Are we done?
-  R Bool
+  -- | The comment that was output, if any
+  R (Maybe LComment)
 spitPrecedingComment ref = do
   mlastMark <- getSpanMark
   let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref
@@ -81,14 +81,14 @@ spitPrecedingComment ref = do
 spitFollowingComment ::
   -- | AST element to attach comments to
   RealSrcSpan ->
-  -- | Are we done?
-  R Bool
+  -- | The comment that was output, if any
+  R (Maybe LComment)
 spitFollowingComment ref = do
   mlastMark <- getSpanMark
   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)
+  meSpn <- getEnclosingSpanWhere (/= ref)
   withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->
     if theSameLinePost l ref
       then
@@ -102,8 +102,8 @@ spitFollowingComment ref = do
 
 -- | Output a single remaining comment from the comment stream.
 spitRemainingComment ::
-  -- | Are we done?
-  R Bool
+  -- | The comment that was output, if any
+  R (Maybe LComment)
 spitRemainingComment = do
   mlastMark <- getSpanMark
   withPoppedComment (const True) $ \l comment -> do
@@ -116,33 +116,33 @@ spitRemainingComment = do
 
 -- | Output series of comments.
 handleCommentSeries ::
-  -- | Given location of previous comment, output the next comment
-  -- returning 'True' if we're done
-  R Bool ->
-  -- | Whether we printed any comments
-  R Bool
-handleCommentSeries f = go False
+  -- | Output and return the next comment, if any
+  R (Maybe LComment) ->
+  -- | The comments outputted
+  R [LComment]
+handleCommentSeries f = go
   where
-    go gotSome = do
-      done <- f
-      if done
-        then return gotSome
-        else go True
+    go = do
+      mComment <- f
+      case mComment of
+        Nothing -> return []
+        Just comment -> (comment :) <$> go
 
 -- | Try to pop a comment using given predicate and if there is a comment
 -- matching the predicate, print it out.
 withPoppedComment ::
   -- | Comment predicate
-  (RealLocated Comment -> Bool) ->
+  (LComment -> Bool) ->
   -- | Printing function
   (RealSrcSpan -> Comment -> R ()) ->
   -- | Are we done?
-  R Bool
+  R (Maybe LComment)
 withPoppedComment p f = do
   r <- popComment p
   case r of
-    Nothing -> return True
-    Just (L l comment) -> False <$ f l comment
+    Nothing -> return ()
+    Just (L l comment) -> f l comment
+  return r
 
 -- | Determine if we need to insert a newline between current comment and
 -- last printed comment.
@@ -190,7 +190,7 @@ commentFollowsElt ::
   -- | Location of last comment in the series
   Maybe SpanMark ->
   -- | Comment to test
-  RealLocated Comment ->
+  LComment ->
   Bool
 commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =
   -- A comment follows a AST element if all 4 conditions are satisfied:

src/Ormolu/Printer/Internal.hs

@@ -37,6 +37,7 @@ module Ormolu.Printer.Internal
     nextEltSpan,
     popComment,
     getEnclosingSpan,
+    getEnclosingSpanWhere,
     withEnclosingSpan,
     thisLineSpans,
 
@@ -479,30 +480,26 @@ nextEltSpan = listToMaybe . coerce <$> R (gets scSpanStream)
 -- | Pop a 'Comment' from the 'CommentStream' if given predicate is
 -- satisfied and there are comments in the stream.
 popComment ::
-  (RealLocated Comment -> Bool) ->
-  R (Maybe (RealLocated Comment))
+  (LComment -> Bool) ->
+  R (Maybe LComment)
 popComment f = R $ do
   CommentStream cstream <- gets scCommentStream
   case cstream of
-    [] -> return Nothing
-    (x : xs) ->
-      if f x
-        then
-          Just x
-            <$ modify
-              ( \sc ->
-                  sc
-                    { scCommentStream = CommentStream xs
-                    }
-              )
-        else return Nothing
+    (x : xs) | f x -> do
+      modify $ \sc -> sc {scCommentStream = CommentStream xs}
+      return $ Just x
+    _ -> return Nothing
+
+-- | Get the immediately enclosing 'RealSrcSpan'.
+getEnclosingSpan :: R (Maybe RealSrcSpan)
+getEnclosingSpan = getEnclosingSpanWhere (const True)
 
 -- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.
-getEnclosingSpan ::
+getEnclosingSpanWhere ::
   -- | Predicate to use
   (RealSrcSpan -> Bool) ->
   R (Maybe RealSrcSpan)
-getEnclosingSpan f =
+getEnclosingSpanWhere f =
   find f <$> R (asks rcEnclosingSpans)
 
 -- | Set 'RealSrcSpan' of enclosing span for the given computation.

src/Ormolu/Printer/Meat/Common.hs

@@ -164,7 +164,7 @@ p_hsDoc hstyle needsNewline (L l str) = do
       -- It's often the case that the comment itself doesn't have a span
       -- attached to it and instead its location can be obtained from
       -- nearest enclosing span.
-      getEnclosingSpan (const True) >>= mapM_ (setSpanMark . HaddockSpan hstyle)
+      getEnclosingSpan >>= mapM_ (setSpanMark . HaddockSpan hstyle)
     RealSrcSpan spn _ -> setSpanMark (HaddockSpan hstyle spn)
 
 -- | Print anchor of named doc section.

src/Ormolu/Printer/Meat/Declaration/Value.hs

@@ -703,7 +703,7 @@ p_hsExpr' isApp s = \case
             Unboxed -> parensHash
     enclSpan <-
       fmap (flip RealSrcSpan Strict.Nothing) . maybeToList
-        <$> getEnclosingSpan (const True)
+        <$> getEnclosingSpan
     if isSection
       then
         switchLayout [] . parens' s $

src/Ormolu/Printer/Meat/ImportExport.hs

@@ -19,10 +19,6 @@ import Ormolu.Printer.Meat.Common
 import Ormolu.Utils (RelativePos (..), attachRelativePos)
 
 p_hsmodExports :: [LIE GhcPs] -> R ()
-p_hsmodExports [] = do
-  txt "("
-  breakpoint'
-  txt ")"
 p_hsmodExports xs =
   parens N $ do
     layout <- getLayout

src/Ormolu/Printer/Meat/Module.hs

@@ -24,9 +24,9 @@ import Ormolu.Printer.Meat.Pragma
 -- signature).
 p_hsModule ::
   -- | Stack header
-  Maybe (RealLocated Comment) ->
+  Maybe LComment ->
   -- | Pragmas and the associated comments
-  [([RealLocated Comment], Pragma)] ->
+  [([LComment], Pragma)] ->
   -- | AST to print
   HsModule GhcPs ->
   R ()

src/Ormolu/Printer/Meat/Pragma.hs

@@ -51,7 +51,7 @@ data LanguagePragmaClass
   deriving (Eq, Ord)
 
 -- | Print a collection of 'Pragma's with their associated comments.
-p_pragmas :: [([RealLocated Comment], Pragma)] -> R ()
+p_pragmas :: [([LComment], Pragma)] -> R ()
 p_pragmas ps = do
   let prepare = L.sortOn snd . L.nub . concatMap analyze
       analyze = \case
@@ -63,7 +63,7 @@ p_pragmas ps = do
   forM_ (prepare ps) $ \(cs, (pragmaTy, x)) ->
     p_pragma cs pragmaTy x
 
-p_pragma :: [RealLocated Comment] -> PragmaTy -> Text -> R ()
+p_pragma :: [LComment] -> PragmaTy -> Text -> R ()
 p_pragma comments ty x = do
   forM_ comments $ \(L l comment) -> do
     spitCommentNow l comment