Remove blank Haddock comments

CHANGELOG.md

@@ -10,6 +10,9 @@
   regular module mode and signature mode is based on the file extension by
   default, but can be overridden with the `-t / --source-type` command line
   option. [Issue 600](https://github.com/tweag/ormolu/issues/600).
+* Blank Haddock comments are now eliminated. This also fixes issues with
+  differing ASTs in some special cases. [Issue
+  726](https://github.com/tweag/ormolu/issues/726).
 
 ## Ormolu 0.3.1.0
 

data/examples/module-header/empty-haddock-out.hs

@@ -0,0 +1 @@
+module Test where

data/examples/module-header/empty-haddock.hs

@@ -0,0 +1,3 @@
+-- |
+--
+module Test where

data/examples/other/empty-haddock-out.hs

@@ -1,5 +1,7 @@
-module Main where
+module Test
+  ( test,
+  )
+where
 
--- |
-foo :: Int
-foo = 5
+test ::
+  test

data/examples/other/empty-haddock.hs

@@ -1,6 +1,11 @@
-module Main where
-
 -- |
+module Test
+  ( -- |
+    test,
+  )
+where
 
-foo :: Int
-foo = 5
+-- |
+test ::
+  -- |
+  test

expected-failures/leksah.txt

@@ -1,46 +1,7 @@
-src/IDE/BufferMode.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Common.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Common/GUI.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Common/Helper.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Common/Workspaces.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/GIT.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Mercurial.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Command/VCS/Types.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Completion.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
 src/IDE/Find.hs:615:36-46
   The GHC parser (in Haddock mode) failed:
   Bang pattern in expression context: !matchIndex
 Did you mean to add a space after the '!'?
-src/IDE/HLint.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/LogRef.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/NotebookFlipper.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
 src/IDE/Pane/Modules.hs
 @@ -1182,9 +1182,9 @@
         let modId = mdModuleId modDescr
@@ -57,57 +18,3 @@ src/IDE/Pane/Modules.hs
 
   Formatting is not idempotent.
   Please, consider reporting the bug.
-src/IDE/Pane/Trace.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Pane/Variables.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Pane/WebKit/Documentation.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Pane/WebKit/Inspect.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Pane/WebKit/Output.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/PaneGroups.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Preferences.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/SourceCandy.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/TextEditor.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/TextEditor/Class.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/TextEditor/CodeMirror.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/TextEditor/GtkSourceView.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/TextEditor/Yi.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Utils/CabalUtils.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Utils/DirectoryUtils.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Utils/ExternalTool.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Utils/GUIUtils.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.
-src/IDE/Workspaces/Writer.hs
-  AST of input and AST of formatted code differ.
-  Please, consider reporting the bug.

expected-failures/pipes.txt

@@ -3,8 +3,3 @@ src/Pipes/Core.hs
   AST of input and AST of formatted code differ.
     at src/Pipes/Core.hs:(128,1)-(151,2)
   Please, consider reporting the bug.
-src/Pipes/Lift.hs
-  AST of input and AST of formatted code differ.
-    at src/Pipes/Lift.hs:75:8-30
-    at src/Pipes/Lift.hs:77:8-30
-  Please, consider reporting the bug.

src/Ormolu/Diff/ParseResult.hs

@@ -21,7 +21,6 @@ import Data.Generics
 import GHC.Hs
 import GHC.Types.Basic
 import GHC.Types.SrcLoc
-import Ormolu.Imports (normalizeImports)
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
 import Ormolu.Utils
@@ -56,9 +55,7 @@ diffParseResult
       prParsedSource = hs1
     } =
     diffCommentStream cstream0 cstream1
-      <> matchIgnoringSrcSpans
-        hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}
-        hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}
+      <> matchIgnoringSrcSpans hs0 hs1
 
 diffCommentStream :: CommentStream -> CommentStream -> ParseResultDiff
 diffCommentStream (CommentStream cs) (CommentStream cs')

src/Ormolu/Parser.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- | Parser for Haskell source code.
@@ -12,7 +14,9 @@ where
 
 import Control.Exception
 import Control.Monad.Except
+import Data.Char (isSpace)
 import Data.Functor
+import Data.Generics
 import qualified Data.List as L
 import qualified Data.List.NonEmpty as NE
 import Data.Ord (Down (Down))
@@ -24,6 +28,7 @@ import qualified GHC.Driver.CmdLine as GHC
 import GHC.Driver.Session as GHC
 import qualified GHC.Driver.Types as GHC
 import GHC.DynFlags (baseDynFlags)
+import GHC.Hs
 import GHC.LanguageExtensions.Type (Extension (..))
 import qualified GHC.Parser as GHC
 import qualified GHC.Parser.Header as GHC
@@ -34,6 +39,7 @@ import GHC.Utils.Error (Severity (..), errMsgSeverity, errMsgSpan)
 import qualified GHC.Utils.Panic as GHC
 import Ormolu.Config
 import Ormolu.Exception
+import Ormolu.Imports (normalizeImports)
 import Ormolu.Parser.Anns
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Result
@@ -110,7 +116,7 @@ parseModuleSnippet Config {..} dynFlags path rawInput = liftIO $ do
           case pStateErrors pstate of
             Just err -> Left err
             Nothing -> error "PFailed does not have an error"
-        GHC.POk pstate (L _ hsModule) ->
+        GHC.POk pstate (L _ (normalizeModule -> 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 "_"
@@ -134,6 +140,37 @@ parseModuleSnippet Config {..} dynFlags path rawInput = liftIO $ do
                       }
   return r
 
+-- | Normalize a 'HsModule' by sorting its import\/export lists, dropping
+-- blank comments, etc.
+normalizeModule :: HsModule -> HsModule
+normalizeModule hsmod =
+  everywhere
+    (mkT dropBlankTypeHaddocks)
+    hsmod
+      { hsmodImports =
+          normalizeImports (hsmodImports hsmod),
+        hsmodDecls =
+          filter (not . isBlankDocD . unLoc) (hsmodDecls hsmod),
+        hsmodHaddockModHeader =
+          mfilter (not . isBlankDocString . unLoc) (hsmodHaddockModHeader hsmod),
+        hsmodExports =
+          (fmap . fmap) (filter (not . isBlankDocIE . unLoc)) (hsmodExports hsmod)
+      }
+  where
+    isBlankDocString = all isSpace . unpackHDS
+    isBlankDocD = \case
+      DocD _ s -> isBlankDocString $ docDeclDoc s
+      _ -> False
+    isBlankDocIE = \case
+      IEGroup _ _ s -> isBlankDocString s
+      IEDoc _ s -> isBlankDocString s
+      _ -> False
+
+    dropBlankTypeHaddocks = \case
+      L _ (HsDocTy _ ty (L _ ds)) :: LHsType GhcPs
+        | isBlankDocString ds -> ty
+      a -> a
+
 -- | Enable all language extensions that we think should be enabled by
 -- default for ease of use.
 setDefaultExts :: DynFlags -> DynFlags

src/Ormolu/Parser/CommentStream.hs

@@ -80,7 +80,7 @@ mkCommentStream input pstate hsModule =
       where
         -- All comments, including valid and invalid Haddock comments
         allComments =
-          fmap (fmap unAnnotationComment)
+          mapMaybe (traverse unAnnotationComment)
             . (GHC.comment_q <> (concatMap snd . GHC.annotations_comments))
             $ pstate
         -- All spans of valid Haddock comments
@@ -226,26 +226,28 @@ extractPragmas input = go initialLs id id
                           else go' ls [] xs
 
 -- | Get a 'String' from 'GHC.AnnotationComment'.
-unAnnotationComment :: GHC.AnnotationComment -> String
+unAnnotationComment :: GHC.AnnotationComment -> Maybe String
 unAnnotationComment = \case
-  GHC.AnnDocCommentNext s -> dashPrefix s -- @-- |@
-  GHC.AnnDocCommentPrev s -> dashPrefix s -- @-- ^@
-  GHC.AnnDocCommentNamed s -> dashPrefix s -- @-- $@
-  GHC.AnnDocSection _ s -> dashPrefix s -- @-- *@
-  GHC.AnnDocOptions s -> s
-  GHC.AnnLineComment s -> do
+  GHC.AnnDocCommentNext s -> dashPrefix <$> dropBlank s -- @-- |@
+  GHC.AnnDocCommentPrev s -> dashPrefix <$> dropBlank s -- @-- ^@
+  GHC.AnnDocCommentNamed s -> dashPrefix <$> dropBlank s -- @-- $@
+  GHC.AnnDocSection _ s -> dashPrefix <$> dropBlank s -- @-- *@
+  GHC.AnnDocOptions s -> Just s
+  GHC.AnnLineComment s -> Just $ do
     case take 3 s of
       "-- " -> s
       "---" -> s
       _ -> let s' = insertAt " " s 3 in s'
-  GHC.AnnBlockComment s -> s
+  GHC.AnnBlockComment s -> Just s
   where
     insertAt x xs n = take (n - 1) xs ++ x ++ drop (n - 1) xs
     dashPrefix s = "--" <> spaceIfNecessary <> s
       where
         spaceIfNecessary = case s of
           c : _ | c /= ' ' -> " "
           _ -> ""
+    dropBlank :: String -> Maybe String
+    dropBlank s = if all isSpace s then Nothing else Just s
 
 -- | Remove consecutive blank lines.
 removeConseqBlanks :: NonEmpty String -> NonEmpty String

src/Ormolu/Printer/Meat/Module.hs

@@ -11,7 +11,6 @@ where
 import Control.Monad
 import GHC.Hs
 import GHC.Types.SrcLoc
-import Ormolu.Imports (normalizeImports)
 import Ormolu.Parser.CommentStream
 import Ormolu.Parser.Pragma
 import Ormolu.Printer.Combinators
@@ -61,7 +60,7 @@ p_hsModule mstackHeader pragmas HsModule {..} = do
         txt "where"
         newline
     newline
-    forM_ (normalizeImports hsmodImports) (located' p_hsmodImport)
+    forM_ hsmodImports (located' p_hsmodImport)
     newline
     switchLayout (getLoc <$> hsmodDecls) $ do
       p_hsDecls Free hsmodDecls