Fix rendering of module headers

CHANGELOG.md

@@ -19,6 +19,9 @@
   select a region to format. [Issue
   516](https://github.com/tweag/ormolu/issues/516).
 
+* Fixed rendering of module headers in the presence of preceding comments or
+  Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561).
+
 ## Ormolu 0.0.4.0
 
 * When given several files to format, Ormolu does not stop on the first

app/Main.hs

@@ -4,10 +4,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 
-module Main
-  ( main,
-  )
-where
+module Main (main) where
 
 import Control.Exception (SomeException, displayException, try)
 import Control.Monad

data/examples/module-header/double-dot-with-names-out.hs

@@ -1,11 +1,6 @@
 {-# LANGUAGE PatternSynonyms #-}
 
-module ExportSyntax
-  ( A (.., NoA),
-    Q (F, ..),
-    G (T, .., U),
-  )
-where
+module ExportSyntax (A (.., NoA), Q (F, ..), G (T, .., U)) where
 
 data A = A | B
 

data/examples/module-header/multiline2.hs

@@ -1,2 +1,2 @@
-module Foo
-  (foo, bar, baz) where
+module Foo (
+  foo, bar, baz) where

data/examples/module-header/preceding-comment-with-haddock-out.hs

@@ -3,9 +3,6 @@
 -}
 
 -- | This is the module's Haddock.
-module Main
-  ( main,
-  )
-where
+module Main (main) where
 
 main = return ()

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

@@ -1,5 +1,2 @@
 -- | This demonstrates a BUG.
-module Foo
-  (
-  )
-where
+module Foo () where

data/examples/module-header/warning-pragma-multiline-out.hs

@@ -1,9 +1,6 @@
 module Test
   {-# DEPRECATED "This module is unstable" #-}
-  ( foo,
-    bar,
-    baz,
-  )
+  (foo, bar, baz)
 where
 
 import Blah

data/examples/module-header/warning-pragma-out.hs

@@ -1,3 +1,5 @@
 module Test
-  {-# WARNING "This module is very internal" #-}
+  {-# WARNING
+    "This module is very internal"
+    #-}
 where

data/examples/other/pragma-comments-out.hs

@@ -5,7 +5,4 @@
 {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}
 
 -- | Header comment.
-module Foo
-  (
-  )
-where
+module Foo () where

data/examples/other/pragma-out.hs

@@ -9,7 +9,4 @@
 {-# OPTIONS_HADDOCK prune, show-extensions #-}
 
 -- | Header comment.
-module Foo
-  (
-  )
-where
+module Foo () where

default.nix

@@ -134,17 +134,17 @@ in {
       cp src.hs result-all-implicit.hs
       ormolu --check-idempotency --mode inplace result-all-implicit.hs
       cp src.hs result-all-explicit.hs
-      ormolu --check-idempotency --mode inplace --start-line 1 --end-line 12 result-all-explicit.hs
+      ormolu --check-idempotency --mode inplace --start-line 1 --end-line 13 result-all-explicit.hs
       cp src.hs result-only-start.hs
       ormolu --check-idempotency --mode inplace --start-line 1 result-only-start.hs
       cp src.hs result-only-end.hs
-      ormolu --check-idempotency --mode inplace --end-line 12 result-only-end.hs
-      cp src.hs result-5-6.hs
-      ormolu --check-idempotency --mode inplace --start-line 5 --end-line 6 result-5-6.hs
-      cp src.hs result-5-7.hs
-      ormolu --check-idempotency --mode inplace --start-line 5 --end-line 7 result-5-7.hs
-      cp src.hs result-8-12.hs
-      ormolu --check-idempotency --mode inplace --start-line 8 --end-line 12 result-8-12.hs
+      ormolu --check-idempotency --mode inplace --end-line 13 result-only-end.hs
+      cp src.hs result-6-7.hs
+      ormolu --check-idempotency --mode inplace --start-line 6 --end-line 7 result-6-7.hs
+      cp src.hs result-6-8.hs
+      ormolu --check-idempotency --mode inplace --start-line 6 --end-line 8 result-6-8.hs
+      cp src.hs result-9-13.hs
+      ormolu --check-idempotency --mode inplace --start-line 9 --end-line 13 result-9-13.hs
     '';
     checkPhase = ''
       echo result-all-implicit.hs
@@ -155,12 +155,12 @@ in {
       diff --color=always expected-result-all.hs result-only-start.hs
       echo result-only-end.hs
       diff --color=always expected-result-all.hs result-only-end.hs
-      echo result-5-6.hs
-      diff --color=always expected-result-5-6.hs result-5-6.hs
-      echo result-5-7.hs
-      diff --color=always expected-result-5-7.hs result-5-7.hs
-      echo result-8-12.hs
-      diff --color=always expected-result-8-12.hs result-8-12.hs
+      echo result-6-7.hs
+      diff --color=always expected-result-6-7.hs result-6-7.hs
+      echo result-6-8.hs
+      diff --color=always expected-result-6-8.hs result-6-8.hs
+      echo result-9-13.hs
+      diff --color=always expected-result-9-13.hs result-9-13.hs
     '';
     installPhase = ''
       mkdir "$out"

expected-failures/Agda.txt

@@ -16,7 +16,7 @@ Parsing of formatted code failed:
 Please, consider reporting the bug.
 
 Formatting is not idempotent:
-  src/full/Agda/Termination/CallGraph.hs<rendered>:152:38
+  src/full/Agda/Termination/CallGraph.hs<rendered>:151:38
   before: "2, old2) = -- TODO: "
   after:  "2, old2) =\n        -"
 Please, consider reporting the bug.

expected-failures/idris.txt

@@ -23,7 +23,7 @@ Formatting is not idempotent:
 Please, consider reporting the bug.
 
 Formatting is not idempotent:
-  src/Idris/Core/WHNF.hs<rendered>:110:46
+  src/Idris/Core/WHNF.hs<rendered>:105:46
   before: " n b sc) = -- stk mu"
   after:  " n b sc) =\n      -- "
 Please, consider reporting the bug.
@@ -41,7 +41,7 @@ Formatting is not idempotent:
 Please, consider reporting the bug.
 
 Formatting is not idempotent:
-  src/Idris/ModeCommon.hs<rendered>:40:26
+  src/Idris/ModeCommon.hs<rendered>:34:26
   before: "s toline = -- furthe"
   after:  "s toline =\n  -- furt"
 Please, consider reporting the bug.
@@ -77,7 +77,7 @@ Formatting is not idempotent:
 Please, consider reporting the bug.
 
 Formatting is not idempotent:
-  src/Idris/Prover.hs<rendered>:244:10
+  src/Idris/Prover.hs<rendered>:239:10
   before: "      line <> bindin"
   after:  "      line\n        <"
 Please, consider reporting the bug.

expected-failures/pandoc.txt

@@ -9,7 +9,7 @@ Formatting is not idempotent:
 Please, consider reporting the bug.
 
 Formatting is not idempotent:
-  src/Text/Pandoc/Writers/Docx.hs<rendered>:997:25
+  src/Text/Pandoc/Writers/Docx.hs<rendered>:994:25
   before: "          -- w:p\n   "
   after:  "            -- w:p\n "
 Please, consider reporting the bug.

region-tests/expected-result-6-7.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Main (main) where
+module Foo (
+  foo, bar) where
 
 foo :: Int
 foo = 5

region-tests/expected-result-6-8.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Main (main) where
+module Foo (
+  foo, bar) where
 
 foo :: Int
 foo = 5

region-tests/expected-result-9-13.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Main (main) where
+module Foo (
+  foo, bar) where
 
 foo :: Int
 foo  =  5

region-tests/expected-result-all.hs

@@ -1,7 +1,8 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Main
-  ( main,
+module Foo
+  ( foo,
+    bar,
   )
 where
 

region-tests/src.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE LambdaCase #-}
 
-module Main (main) where
+module Foo (
+  foo, bar) where
 
 foo :: Int
 foo  =  5

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

@@ -27,9 +27,7 @@ p_warnDecl (XWarnDecl x) = noExtCon x
 p_moduleWarning :: WarningTxt -> R ()
 p_moduleWarning wtxt = do
   let (pragmaText, lits) = warningText wtxt
-  switchLayout (getLoc <$> lits)
-    $ inci
-    $ pragma pragmaText (inci $ p_lits lits)
+  inci $ pragma pragmaText $ inci $ p_lits lits
 
 p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
 p_topLevelWarning fnames wtxt = do

src/Ormolu/Printer/Meat/Module.hs

@@ -36,14 +36,10 @@ p_hsModule ::
   -- | AST to print
   ParsedSource ->
   R ()
-p_hsModule mstackHeader shebangs pragmas qualifiedPost (L moduleSpan HsModule {..}) = do
-  -- If span of exports in multiline, the whole thing is multiline. This is
-  -- especially important because span of module itself always seems to have
-  -- length zero, so it's not reliable for layout selection.
-  let exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports
-      deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage
-      spans' = exportSpans ++ deprecSpan ++ [moduleSpan]
-  switchLayout spans' $ do
+p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do
+  let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage
+      exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports
+  switchLayout (deprecSpan <> exportSpans) $ do
     forM_ shebangs $ \(Shebang x) ->
       located x $ \shebang -> do
         txt (T.pack shebang)
@@ -60,15 +56,16 @@ p_hsModule mstackHeader shebangs pragmas qualifiedPost (L moduleSpan HsModule {.
         located hsmodName' $ \name -> do
           forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)
           p_hsmodName name
+        breakpoint
         forM_ hsmodDeprecMessage $ \w -> do
-          breakpoint
           located' p_moduleWarning w
+          breakpoint
         case hsmodExports of
           Nothing -> return ()
-          Just hsmodExports' -> do
+          Just l -> do
+            located l $ \exports -> do
+              inci (p_hsmodExports exports)
             breakpoint
-            inci (p_hsmodExports (unLoc hsmodExports'))
-        breakpoint
         txt "where"
         newline
     newline

tests/Ormolu/PrinterSpec.hs

@@ -1,9 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
 
-module Ormolu.PrinterSpec
-  ( spec,
-  )
-where
+module Ormolu.PrinterSpec (spec) where
 
 import Control.Exception
 import Control.Monad