Properly handle comments at the end of imports

comments between top-level decls should be considered
for inline-config. But despite being placed between
top-level decls, occasionally they get connected
somewhere nested inside the AST of the first decl.
We fix this by extracting such comments in a
pre-processing step. The control flow was significantly
altered to allow for this;
before:
  parsing -> extract inline configs
          -> compute final config(s)
          -> split module into head/decls/comments/whitespace
          -> ... bridoc -> transformations -> printing
after:
  parsing -> split module into head/decl/comments/whitespace
          -> extract inline configs respecting comments that
             got extracted from decls in the previous step
          -> compute final config(s)
          -> ... bridoc -> transformations -> printing

data/15-regressions.blt

@@ -998,3 +998,56 @@ func = do
 func False = 0
 -- comment
 func True  = 1
+
+#test nested do-block-with-comment issue
+dofunc = do
+  do
+    some
+    code
+  do
+    -- abc
+    more
+    code
+
+#test do-block paren non-alignment
+catchFunc = do
+  (func aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+        aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+    )
+    `catch` catcher
+
+#test comment after lambdacase
+func = \case
+  -- zzz
+  False -> 0
+  True  -> 1
+
+#test comment for recordfield
+func = myRecord { field      = -- comment
+                               if some condition then option one else option two
+                , otherfield = "text"
+                }
+
+#test multiline guards within parenthesis
+duGswidunBlxaq drux = DeeX.Vufcqqafi
+  (tiErihambSunxo drux)
+  (if
+    | geIqzscmBhiwo drux
+    -> Bmuh "Hpiioqa a yabufx ynyuq"
+    | liWaov drux
+    -> Bmuh "Ookhup ubqocf merr ukm ynyuq iitiop"
+    | tiErihambSunxo drux && bdp (alJukIkuh drux)
+    -> Bmuh "Jpgic dfaz dieb fs wreup hsv of ynyuq dio njr subdet"
+    | ukFinwuicUgIcclcep drux
+    -> Bmuh "Egwiqae-ka-molenqe codns dif'y ns csjyhth sisoyy"
+    | otherwise
+    -> Likiotq
+  )
+
+#test multiline-block-comment in do-block
+func = do
+  abc
+  {- some long
+     block comment -}
+  x <- readLine
+  print x

source/library/Language/Haskell/Brittany/Internal.hs

@@ -10,6 +10,8 @@ module Language.Haskell.Brittany.Internal
    -- re-export from utils:
   , extractCommentConfigs
   , TraceFunc(TraceFunc)
+  , Splitting.splitModuleDecls
+  , Splitting.extractDeclMap
   )
 where
 
@@ -17,7 +19,6 @@ import           Control.Monad.Trans.Except
 import           Data.CZipWith
 import qualified Data.Text                     as Text
 import qualified Data.Text.Lazy                as TextL
-import qualified GHC                     hiding ( parseModule )
 import qualified GHC.Driver.Session            as GHC
 import           GHC.Hs
 import qualified GHC.LanguageExtensions.Type   as GHC
@@ -29,6 +30,8 @@ import           Language.Haskell.Brittany.Internal.S3_ToBriDocTools
 import           Language.Haskell.Brittany.Internal.Prelude
 import qualified Language.Haskell.Brittany.Internal.S1_Parsing
                                                as Parsing
+import qualified Language.Haskell.Brittany.Internal.S2_SplitModule
+                                               as Splitting
 import           Language.Haskell.Brittany.Internal.StepOrchestrate
                                                 ( processModule )
 import           Language.Haskell.Brittany.Internal.Types
@@ -79,9 +82,13 @@ parsePrintModule traceFunc configWithDebugs inputText = runExceptT $ do
     case parseResult of
       Left  err -> throwE [ErrorInput err]
       Right x   -> pure x
+  let moduleElementList = Splitting.splitModuleDecls parsedSource
   (inlineConf, perItemConf) <-
     mapExceptT (fmap $ bimap (\(a, b) -> [ErrorMacroConfig a b]) id)
-      $ extractCommentConfigs (useTraceFunc traceFunc) parsedSource
+      $ extractCommentConfigs
+        (useTraceFunc traceFunc)
+        (Splitting.extractDeclMap parsedSource)
+        moduleElementList
   let moduleConfig = cZipWith fromOptionIdentity config inlineConf
   let disableFormatting =
         moduleConfig & _conf_disable_formatting & confUnpack
@@ -96,11 +103,12 @@ parsePrintModule traceFunc configWithDebugs inputText = runExceptT $ do
                 & _econf_omit_output_valid_check
                 & confUnpack
         (ews, outRaw) <- if hasCPP || omitCheck
-          then lift $ processModule traceFunc moduleConfig perItemConf parsedSource
+          then lift
+            $ processModule traceFunc moduleConfig perItemConf moduleElementList
           else lift $ pPrintModuleAndCheck traceFunc
                                            moduleConfig
                                            perItemConf
-                                           parsedSource
+                                           moduleElementList
         let hackF s = fromMaybe s
               $ TextL.stripPrefix (TextL.pack "-- BRITANY_INCLUDE_HACK ") s
         pure $ if hackAroundIncludes
@@ -134,11 +142,11 @@ pPrintModuleAndCheck
   :: TraceFunc
   -> Config
   -> PerItemConfig
-  -> GHC.ParsedSource
+  -> FinalList ModuleElement p
   -> IO ([BrittanyError], TextL.Text)
-pPrintModuleAndCheck traceFunc conf inlineConf parsedModule = do
+pPrintModuleAndCheck traceFunc conf inlineConf moduleElementList = do
   let ghcOptions     = conf & _conf_forward & _options_ghc & runIdentity
-  (errs, output) <- processModule traceFunc conf inlineConf parsedModule
+  (errs, output) <- processModule traceFunc conf inlineConf moduleElementList
   parseResult <- Parsing.parseModuleFromString ghcOptions
                                                "output"
                                                (\_ -> return $ Right ())
@@ -162,10 +170,14 @@ parsePrintModuleTests conf filename input = do
   case parseResult of
     Left  err               -> return $ Left err
     Right (parsedModule, _) -> runExceptT $ do
+      let moduleElementList = Splitting.splitModuleDecls parsedModule
       (inlineConf, perItemConf) <-
         mapExceptT
           (fmap (bimap (\(a, _) -> "when parsing inline config: " ++ a) id))
-          $ extractCommentConfigs (\_ -> pure ()) parsedModule
+          $ extractCommentConfigs
+            (\_ -> pure ())
+            (Splitting.extractDeclMap parsedModule)
+            moduleElementList
       let moduleConf = cZipWith fromOptionIdentity conf inlineConf
       let omitCheck =
             conf
@@ -176,11 +188,11 @@ parsePrintModuleTests conf filename input = do
         then lift $ processModule (TraceFunc $ \_ -> pure ())
                                    moduleConf
                                    perItemConf
-                                   parsedModule
+                                   moduleElementList
         else lift $ pPrintModuleAndCheck (TraceFunc $ \_ -> pure ())
                                          moduleConf
                                          perItemConf
-                                         parsedModule
+                                         moduleElementList
       if null errs
         then pure $ TextL.toStrict $ ltext
         else throwE

source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs

@@ -193,143 +193,143 @@ remSuperfluousParens outerFixity = \case
 
 hardcodedFixity :: Bool -> String -> Maybe Fixity
 hardcodedFixity allowUnqualify = \case
-  "."         -> Just $ Fixity NoSourceText 9 InfixR
-  "!!"        -> Just $ Fixity NoSourceText 9 InfixL
-  "**"        -> Just $ Fixity NoSourceText 8 InfixR
-  "^"         -> Just $ Fixity NoSourceText 8 InfixR
-  "^^"        -> Just $ Fixity NoSourceText 8 InfixR
-  "*"         -> Just $ Fixity NoSourceText 7 InfixL
-  "/"         -> Just $ Fixity NoSourceText 7 InfixL
-  "`quot`"    -> Just $ Fixity NoSourceText 7 InfixL
-  "`rem`"     -> Just $ Fixity NoSourceText 7 InfixL
-  "`div`"     -> Just $ Fixity NoSourceText 7 InfixL
-  "`mod`"     -> Just $ Fixity NoSourceText 7 InfixL
-  "+"         -> Just $ Fixity NoSourceText 6 InfixL
-  "-"         -> Just $ Fixity NoSourceText 6 InfixL
-  ":"         -> Just $ Fixity NoSourceText 5 InfixR
-  "=="        -> Just $ Fixity NoSourceText 4 InfixN
-  "/="        -> Just $ Fixity NoSourceText 4 InfixN
-  "<"         -> Just $ Fixity NoSourceText 4 InfixN
-  "<="        -> Just $ Fixity NoSourceText 4 InfixN
-  ">"         -> Just $ Fixity NoSourceText 4 InfixN
-  ">="        -> Just $ Fixity NoSourceText 4 InfixN
-  "&&"        -> Just $ Fixity NoSourceText 3 InfixR
-  "||"        -> Just $ Fixity NoSourceText 2 InfixR
-  ">>="       -> Just $ Fixity NoSourceText 1 InfixL
-  ">>"        -> Just $ Fixity NoSourceText 1 InfixL
-  "=<<"       -> Just $ Fixity NoSourceText 1 InfixR
-  "$"         -> Just $ Fixity NoSourceText 0 InfixR
-  "`seq`"     -> Just $ Fixity NoSourceText 0 InfixR
-  "$!"        -> Just $ Fixity NoSourceText 0 InfixR
-  "!"         -> Just $ Fixity NoSourceText 9 InfixL
-  "//"        -> Just $ Fixity NoSourceText 9 InfixL
-  "<>"        -> Just $ Fixity NoSourceText 6 InfixR
-  "<+>"       -> Just $ Fixity NoSourceText 5 InfixR
-  "<$"        -> Just $ Fixity NoSourceText 4 InfixL
-  "$>"        -> Just $ Fixity NoSourceText 4 InfixL
-  "<$>"       -> Just $ Fixity NoSourceText 4 InfixL
-  "<&>"       -> Just $ Fixity NoSourceText 1 InfixL
-  "&"         -> Just $ Fixity NoSourceText 1 InfixL
-  "<*>"       -> Just $ Fixity NoSourceText 4 InfixL
-  "<**>"      -> Just $ Fixity NoSourceText 4 InfixL
-  "*>"        -> Just $ Fixity NoSourceText 4 InfixL
-  "<*"        -> Just $ Fixity NoSourceText 4 InfixL
-  "`elem`"    -> Just $ Fixity NoSourceText 4 InfixN
-  "`notElem`" -> Just $ Fixity NoSourceText 4 InfixN
-  "++"        -> Just $ Fixity NoSourceText 5 InfixR
-  "%"         -> Just $ Fixity NoSourceText 7 InfixL
-  "<|>"       -> Just $ Fixity NoSourceText 3 InfixL
-  ".&."       -> Just $ Fixity NoSourceText 7 InfixL
-  ".|."       -> Just $ Fixity NoSourceText 5 InfixL
-  "`xor`"     -> Just $ Fixity NoSourceText 6 InfixL
-  "`shift`"   -> Just $ Fixity NoSourceText 8 InfixL
-  "`rotate`"  -> Just $ Fixity NoSourceText 8 InfixL
-  "`shiftL`"  -> Just $ Fixity NoSourceText 8 InfixL
-  "`shiftR`"  -> Just $ Fixity NoSourceText 8 InfixL
-  "`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL
-  "`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL
-  "+#"        -> Just $ Fixity NoSourceText 6 InfixL
-  ".^."       -> Just $ Fixity NoSourceText 6 InfixL
-  ".>>."      -> Just $ Fixity NoSourceText 8 InfixL
-  ".<<."      -> Just $ Fixity NoSourceText 8 InfixL
-  "!>>."      -> Just $ Fixity NoSourceText 8 InfixL
-  "!<<."      -> Just $ Fixity NoSourceText 8 InfixL
-  ">=>"       -> Just $ Fixity NoSourceText 1 InfixR
-  "<=<"       -> Just $ Fixity NoSourceText 1 InfixR
-  "&&&"       -> Just $ Fixity NoSourceText 3 InfixR
-  "<$!>"      -> fixity InfixL 4
+  "."           -> Just $ Fixity NoSourceText 9 InfixR
+  "!!"          -> Just $ Fixity NoSourceText 9 InfixL
+  "**"          -> Just $ Fixity NoSourceText 8 InfixR
+  "^"           -> Just $ Fixity NoSourceText 8 InfixR
+  "^^"          -> Just $ Fixity NoSourceText 8 InfixR
+  "*"           -> Just $ Fixity NoSourceText 7 InfixL
+  "/"           -> Just $ Fixity NoSourceText 7 InfixL
+  "`quot`"      -> Just $ Fixity NoSourceText 7 InfixL
+  "`rem`"       -> Just $ Fixity NoSourceText 7 InfixL
+  "`div`"       -> Just $ Fixity NoSourceText 7 InfixL
+  "`mod`"       -> Just $ Fixity NoSourceText 7 InfixL
+  "+"           -> Just $ Fixity NoSourceText 6 InfixL
+  "-"           -> Just $ Fixity NoSourceText 6 InfixL
+  ":"           -> Just $ Fixity NoSourceText 5 InfixR
+  "=="          -> Just $ Fixity NoSourceText 4 InfixN
+  "/="          -> Just $ Fixity NoSourceText 4 InfixN
+  "<"           -> Just $ Fixity NoSourceText 4 InfixN
+  "<="          -> Just $ Fixity NoSourceText 4 InfixN
+  ">"           -> Just $ Fixity NoSourceText 4 InfixN
+  ">="          -> Just $ Fixity NoSourceText 4 InfixN
+  "&&"          -> Just $ Fixity NoSourceText 3 InfixR
+  "||"          -> Just $ Fixity NoSourceText 2 InfixR
+  ">>="         -> Just $ Fixity NoSourceText 1 InfixL
+  ">>"          -> Just $ Fixity NoSourceText 1 InfixL
+  "=<<"         -> Just $ Fixity NoSourceText 1 InfixR
+  "$"           -> Just $ Fixity NoSourceText 0 InfixR
+  "`seq`"       -> Just $ Fixity NoSourceText 0 InfixR
+  "$!"          -> Just $ Fixity NoSourceText 0 InfixR
+  "!"           -> Just $ Fixity NoSourceText 9 InfixL
+  "//"          -> Just $ Fixity NoSourceText 9 InfixL
+  "<>"          -> Just $ Fixity NoSourceText 6 InfixR
+  "<+>"         -> Just $ Fixity NoSourceText 5 InfixR
+  "<$"          -> Just $ Fixity NoSourceText 4 InfixL
+  "$>"          -> Just $ Fixity NoSourceText 4 InfixL
+  "<$>"         -> Just $ Fixity NoSourceText 4 InfixL
+  "<&>"         -> Just $ Fixity NoSourceText 1 InfixL
+  "&"           -> Just $ Fixity NoSourceText 1 InfixL
+  "<*>"         -> Just $ Fixity NoSourceText 4 InfixL
+  "<**>"        -> Just $ Fixity NoSourceText 4 InfixL
+  "*>"          -> Just $ Fixity NoSourceText 4 InfixL
+  "<*"          -> Just $ Fixity NoSourceText 4 InfixL
+  "`elem`"      -> Just $ Fixity NoSourceText 4 InfixN
+  "`notElem`"   -> Just $ Fixity NoSourceText 4 InfixN
+  "++"          -> Just $ Fixity NoSourceText 5 InfixR
+  "%"           -> Just $ Fixity NoSourceText 7 InfixL
+  "<|>"         -> Just $ Fixity NoSourceText 3 InfixL
+  ".&."         -> Just $ Fixity NoSourceText 7 InfixL
+  ".|."         -> Just $ Fixity NoSourceText 5 InfixL
+  "`xor`"       -> Just $ Fixity NoSourceText 6 InfixL
+  "`shift`"     -> Just $ Fixity NoSourceText 8 InfixL
+  "`rotate`"    -> Just $ Fixity NoSourceText 8 InfixL
+  "`shiftL`"    -> Just $ Fixity NoSourceText 8 InfixL
+  "`shiftR`"    -> Just $ Fixity NoSourceText 8 InfixL
+  "`rotateL`"   -> Just $ Fixity NoSourceText 8 InfixL
+  "`rotateR`"   -> Just $ Fixity NoSourceText 8 InfixL
+  "+#"          -> Just $ Fixity NoSourceText 6 InfixL
+  ".^."         -> Just $ Fixity NoSourceText 6 InfixL
+  ".>>."        -> Just $ Fixity NoSourceText 8 InfixL
+  ".<<."        -> Just $ Fixity NoSourceText 8 InfixL
+  "!>>."        -> Just $ Fixity NoSourceText 8 InfixL
+  "!<<."        -> Just $ Fixity NoSourceText 8 InfixL
+  ">=>"         -> Just $ Fixity NoSourceText 1 InfixR
+  "<=<"         -> Just $ Fixity NoSourceText 1 InfixR
+  "&&&"         -> Just $ Fixity NoSourceText 3 InfixR
+  "<$!>"        -> fixity InfixL 4
 
-  "~"         -> fixity InfixN 4
-  "~~"        -> fixity InfixN 4
-  ":~:"       -> Just $ Fixity NoSourceText 4 InfixN
-  ":~~:"      -> Just $ Fixity NoSourceText 4 InfixN
-  ":+:"       -> fixity InfixR 5
-  ":*:"       -> fixity InfixR 6
-  ":.:"       -> fixity InfixR 7
-  ":|"        -> fixity InfixR 5
+  "~"           -> fixity InfixN 4
+  "~~"          -> fixity InfixN 4
+  ":~:"         -> Just $ Fixity NoSourceText 4 InfixN
+  ":~~:"        -> Just $ Fixity NoSourceText 4 InfixN
+  ":+:"         -> fixity InfixR 5
+  ":*:"         -> fixity InfixR 6
+  ":.:"         -> fixity InfixR 7
+  ":|"          -> fixity InfixR 5
 
   -- non-base from random sources.
-  "<|"        -> Just $ Fixity NoSourceText 5 InfixR
-  "|>"        -> Just $ Fixity NoSourceText 5 InfixL
-  "><"        -> Just $ Fixity NoSourceText 5 InfixR
-  "$+$"       -> Just $ Fixity NoSourceText 5 InfixL
-  "\\\\"      -> Just $ Fixity NoSourceText 5 InfixN
-  ".>"        -> Just $ Fixity NoSourceText 9 InfixL
-  ":?"        -> Just $ Fixity NoSourceText 7 InfixN
-  ":-"        -> Just $ Fixity NoSourceText 9 InfixR
-  ".:"        -> Just $ Fixity NoSourceText 9 InfixR
-  "$!!"       -> fixity InfixR 0
-  "<$!!>"     -> fixity InfixL 4
+  "<|"          -> Just $ Fixity NoSourceText 5 InfixR
+  "|>"          -> Just $ Fixity NoSourceText 5 InfixL
+  "><"          -> Just $ Fixity NoSourceText 5 InfixR
+  "$+$"         -> Just $ Fixity NoSourceText 5 InfixL
+  "\\\\"        -> Just $ Fixity NoSourceText 5 InfixN
+  ".>"          -> Just $ Fixity NoSourceText 9 InfixL
+  ":?"          -> Just $ Fixity NoSourceText 7 InfixN
+  ":-"          -> Just $ Fixity NoSourceText 9 InfixR
+  ".:"          -> Just $ Fixity NoSourceText 9 InfixR
+  "$!!"         -> fixity InfixR 0
+  "<$!!>"       -> fixity InfixL 4
 
   -- lens, not complete!
-  "<|"        -> fixity InfixR 5
-  "|>"        -> fixity InfixL 5
-  "%~"        -> fixity InfixR 4
-  ".~"        -> fixity InfixR 4
-  "?~"        -> fixity InfixR 4
-  "<.~"       -> fixity InfixR 4
-  "<?~"       -> fixity InfixR 4
-  "+~"        -> fixity InfixR 4
-  "*~"        -> fixity InfixR 4
-  "-~"        -> fixity InfixR 4
-  "//~"       -> fixity InfixR 4
-  "^~"        -> fixity InfixR 4
-  "^^~"       -> fixity InfixR 4
-  "**~"       -> fixity InfixR 4
-  "||~"       -> fixity InfixR 4
-  "&&~"       -> fixity InfixR 4
-  ".="        -> fixity InfixN 4
-  "%="        -> fixity InfixN 4
-  "?="        -> fixity InfixN 4
-  "+="        -> fixity InfixN 4
-  "-="        -> fixity InfixN 4
-  "*="        -> fixity InfixN 4
-  "//="       -> fixity InfixN 4
-  "^="        -> fixity InfixN 4
-  "^^="       -> fixity InfixN 4
-  "**="       -> fixity InfixN 4
-  "&&="       -> fixity InfixN 4
-  "||="       -> fixity InfixN 4
-  "<~"        -> fixity InfixR 2
-  "<.="       -> fixity InfixN 4
-  "<?="       -> fixity InfixN 4
-  "<>~"       -> fixity InfixR 4
-  "<>="       -> fixity InfixN 4
-  "^.."       -> fixity InfixL 8
-  "^?"        -> fixity InfixL 8
-  "^?!"       -> fixity InfixL 8
-  "^@.."      -> fixity InfixL 8
-  "^@?"       -> fixity InfixL 8
-  "^@?!"      -> fixity InfixL 8
-  "^."        -> fixity InfixL 8
-  "^@."       -> fixity InfixL 8
-  "<."        -> fixity InfixR 9
-  ".>"        -> fixity InfixR 9
-  "<.>"       -> fixity InfixR 9
-  "@@~"       -> fixity InfixR 4
-  "@@="       -> fixity InfixR 4
-  "&~"        -> fixity InfixL 1
-  "??"        -> fixity InfixL 1
+  "<|"          -> fixity InfixR 5
+  "|>"          -> fixity InfixL 5
+  "%~"          -> fixity InfixR 4
+  ".~"          -> fixity InfixR 4
+  "?~"          -> fixity InfixR 4
+  "<.~"         -> fixity InfixR 4
+  "<?~"         -> fixity InfixR 4
+  "+~"          -> fixity InfixR 4
+  "*~"          -> fixity InfixR 4
+  "-~"          -> fixity InfixR 4
+  "//~"         -> fixity InfixR 4
+  "^~"          -> fixity InfixR 4
+  "^^~"         -> fixity InfixR 4
+  "**~"         -> fixity InfixR 4
+  "||~"         -> fixity InfixR 4
+  "&&~"         -> fixity InfixR 4
+  ".="          -> fixity InfixN 4
+  "%="          -> fixity InfixN 4
+  "?="          -> fixity InfixN 4
+  "+="          -> fixity InfixN 4
+  "-="          -> fixity InfixN 4
+  "*="          -> fixity InfixN 4
+  "//="         -> fixity InfixN 4
+  "^="          -> fixity InfixN 4
+  "^^="         -> fixity InfixN 4
+  "**="         -> fixity InfixN 4
+  "&&="         -> fixity InfixN 4
+  "||="         -> fixity InfixN 4
+  "<~"          -> fixity InfixR 2
+  "<.="         -> fixity InfixN 4
+  "<?="         -> fixity InfixN 4
+  "<>~"         -> fixity InfixR 4
+  "<>="         -> fixity InfixN 4
+  "^.."         -> fixity InfixL 8
+  "^?"          -> fixity InfixL 8
+  "^?!"         -> fixity InfixL 8
+  "^@.."        -> fixity InfixL 8
+  "^@?"         -> fixity InfixL 8
+  "^@?!"        -> fixity InfixL 8
+  "^."          -> fixity InfixL 8
+  "^@."         -> fixity InfixL 8
+  "<."          -> fixity InfixR 9
+  ".>"          -> fixity InfixR 9
+  "<.>"         -> fixity InfixR 9
+  "@@~"         -> fixity InfixR 4
+  "@@="         -> fixity InfixR 4
+  "&~"          -> fixity InfixL 1
+  "??"          -> fixity InfixL 1
 
 
   -- certain other operators
@@ -343,50 +343,62 @@ hardcodedFixity allowUnqualify = \case
   -- ".*?"       -> fixity _ _
   -- ".+."       -> fixity _ _
   -- ".-."       -> fixity _ _
-  ".&."       -> fixity InfixR 1
-  ".&&."      -> fixity InfixR 1
-  ".||."      -> fixity InfixR 1
-  "==>"       -> fixity InfixR 0
-  "=/="       -> fixity InfixN 4
-  "==="       -> fixity InfixN 4
-  ".:!"       -> fixity InfixL 9
-  ".:?"       -> fixity InfixL 9
+  ".&."         -> fixity InfixR 1
+  ".&&."        -> fixity InfixR 1
+  ".||."        -> fixity InfixR 1
+  "==>"         -> fixity InfixR 0
+  "=/="         -> fixity InfixN 4
+  "==="         -> fixity InfixN 4
+  ".:!"         -> fixity InfixL 9
+  ".:?"         -> fixity InfixL 9
   -- ".:>"       -> fixity _ _
   -- ".:>?"      -> fixity _ _
-  "<.>"       -> fixity InfixR 7
-  "</>"       -> fixity InfixR 5
-  "<?>"       -> fixity InfixL 9
+  "<.>"         -> fixity InfixR 7
+  "</>"         -> fixity InfixR 5
+  "<?>"         -> fixity InfixL 9
   -- "~"         -> fixity _ _
-  "==="       -> fixity InfixN 4
-  "!?"        -> fixity InfixL 9
-  "%=="       -> fixity InfixN 3
-  ".*"        -> fixity InfixR 8
-  ".**"       -> fixity InfixR 8
-  ".***"      -> fixity InfixR 8
-  ":?-"       -> fixity InfixN 1
-  "::-"       -> fixity InfixN 0
-  "&!"        -> fixity InfixL 1
-  
+  "==="         -> fixity InfixN 4
+  "!?"          -> fixity InfixL 9
+  "%=="         -> fixity InfixN 3
+  ".*"          -> fixity InfixR 8
+  ".**"         -> fixity InfixR 8
+  ".***"        -> fixity InfixR 8
+  ":?-"         -> fixity InfixN 1
+  "::-"         -> fixity InfixN 0
+  "&!"          -> fixity InfixL 1
+
   -- quickcheck (-state-machine)
-  ":&&"       -> fixity InfixL 9
-  ":||"       -> fixity InfixL 9
-  ":&&:"      -> fixity InfixL 9
-  ":=>"       -> fixity InfixL 9
-  ":=="       -> fixity InfixL 9
-  ":/="       -> fixity InfixL 9
-  ":<"        -> fixity InfixL 9
-  ":<="       -> fixity InfixL 9
-  ":>"        -> fixity InfixL 9
-  ":>="       -> fixity InfixL 9
-  ":->"       -> fixity InfixL 9
+  ":&&"         -> fixity InfixL 9
+  ":||"         -> fixity InfixL 9
+  ":&&:"        -> fixity InfixL 9
+  ":=>"         -> fixity InfixL 9
+  ":=="         -> fixity InfixL 9
+  ":/="         -> fixity InfixL 9
+  ":<"          -> fixity InfixL 9
+  ":<="         -> fixity InfixL 9
+  ":>"          -> fixity InfixL 9
+  ":>="         -> fixity InfixL 9
+  ":->"         -> fixity InfixL 9
+  ".=="         -> fixity InfixN 5
+  "./"          -> fixity InfixN 5
+  ".<"          -> fixity InfixN 5
+  ".<="         -> fixity InfixN 5
+  ".>"          -> fixity InfixN 5
+  ".>="         -> fixity InfixN 5
+  "`member`"    -> fixity InfixN 8
+  "`notMember`" -> fixity InfixN 8
+  ".//"         -> fixity InfixL 4
+  ".&&"         -> fixity InfixR 3
+  ".||"         -> fixity InfixR 2
+  ".=>"         -> fixity InfixR 1
 
   -- servant
-  ":>"        -> fixity InfixR 4
-  ":<|>"      -> fixity InfixR 3
-  ":-"        -> fixity InfixL 0
+  ":>"          -> fixity InfixR 4
+  ":<|>"        -> fixity InfixR 3
+  ":-"          -> fixity InfixL 0
 
   -- postgresql-simple
-  ":."        -> fixity InfixR 3 -- this has wildly different fixities in different libraries
+  ":."          -> fixity InfixR 3 -- this has wildly different fixities in different libraries
 
   -- ?
   -- ":-:"       -> fixity _ _
@@ -399,7 +411,7 @@ hardcodedFixity allowUnqualify = \case
   -- ":>:"       -> fixity _ _
   -- ":>=:"      -> fixity _ _
 
-  str         -> case (Safe.headMay str, Safe.lastMay str) of
+  str           -> case (Safe.headMay str, Safe.lastMay str) of
     (Just '\'', _) -> hardcodedFixity False (drop 1 str)
     (Just '`', Just '`') -> Just $ Fixity NoSourceText 9 InfixL
     (Just c, _) | Data.Char.isAlpha c && allowUnqualify -> hardcodedFixity False

source/library/Language/Haskell/Brittany/Internal/Config/InlineParsing.hs

@@ -26,7 +26,7 @@ import           Control.Monad.Trans.Except
 
 import           Language.Haskell.Brittany.Internal.Config.Config
 import           Language.Haskell.Brittany.Internal.Config.Types
-import Language.Haskell.Brittany.Internal.Util.AST
+import Language.Haskell.Brittany.Internal.Types
 import Language.Haskell.Brittany.Internal.Config.Types.Instances1 ()
 import Language.Haskell.Brittany.Internal.Config.Types.Instances2 ()
 -- import Language.Haskell.Brittany.Internal.Utils
@@ -44,46 +44,26 @@ data InlineConfigTarget
 
 extractCommentConfigs
   :: (String -> IO ())
-  -> GHC.ParsedSource
+  -> Map GHC.RealSrcSpan [String]
+  -> FinalList ModuleElement a
   -> ExceptT (String, String) IO (CConfig Maybe, PerItemConfig)
-extractCommentConfigs _putErrorLn modul = do
-  let (L _ (GHC.HsModule modAnn _ _ _ _ decls _ _)) = modul
-  let declMap :: Map GHC.RealSrcSpan [String]
-      declMap = Map.fromList
-        [ ( case span of
-            GHC.RealSrcSpan s _ -> s
-            GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
-          , getDeclBindingNames decl
-          )
-        | decl <- decls
-        , let (L (GHC.SrcSpanAnn _ span) _) = decl
-        ]
-  let epAnnComms = \case
-        GHC.EpAnn _ _ (GHC.EpaComments prior) -> prior
-        GHC.EpAnn _ _ (GHC.EpaCommentsBalanced prior following) ->
-          prior ++ following
-        GHC.EpAnnNotUsed -> []
-  let gatheredComments =
-        join
-          $ epAnnComms modAnn
-          : [ epAnnComms epAnn | L (GHC.SrcSpanAnn epAnn _) _x <- decls ]
-  -- gatheredComments `forM_` \comm@(L anchor _) -> do
-  --   liftIO $ putErrorLn $ showOutputable comm
-  --   case Map.lookupLE (GHC.anchor anchor) declMap of
-  --     Nothing -> pure ()
-  --     Just (pos, le) -> do
-  --       liftIO $ putErrorLn $ "  le = " ++ show (toConstr le) ++ " at " ++ show
-  --         (ExactPrint.Utils.ss2deltaEnd pos (GHC.anchor anchor))
-  --   case Map.lookupGE (GHC.anchor anchor) declMap of
-  --     Nothing -> pure ()
-  --     Just (pos, ge) -> do
-  --       liftIO $ putErrorLn $ "  ge = " ++ show (toConstr ge) ++ " at " ++ show
-  --         (ExactPrint.Utils.ss2deltaStart (GHC.anchor anchor) pos)
+extractCommentConfigs _putErrorLn declMap moduleElementList = do
+  let comments = concatMapFinal (void moduleElementList) $ \case
+        MEExactModuleHead modul -> case GHC.hsmodAnn $ GHC.unLoc modul of
+          GHC.EpAnn _ _ (GHC.EpaComments prior) -> prior
+          GHC.EpAnn _ _ (GHC.EpaCommentsBalanced prior following) ->
+            prior ++ following
+          GHC.EpAnnNotUsed -> []
+        MEPrettyModuleHead{}   -> []
+        MEImportDecl{}         -> []
+        MEDecl{}               -> []
+        MEComment (_, comment) -> [comment]
+        MEWhitespace{}         -> []
   lineConfigs <- sequence
     [ case Butcher.runCmdParserSimpleString line2 parser of
         Left  err            -> throwE (err, line2)
         Right (target, conf) -> pure $ (GHC.anchor anchr, target, conf)
-    | L anchr (EpaComment comm _) <- gatheredComments
+    | L anchr (EpaComment comm _) <- comments
     , Just line1                  <- case comm of
       EpaLineComment l ->
         [ List.stripPrefix "-- BRITTANY" l

source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs

@@ -3,15 +3,18 @@
 -- TODO92
 
 module Language.Haskell.Brittany.Internal.S2_SplitModule
-  ( splitModule
-  )
-where
+  ( extractDeclMap
+  , splitModuleDecls
+  , splitModuleStart
+  ) where
 
 
 
 import           Language.Haskell.Brittany.Internal.Prelude
 
 import qualified Data.Generics                 as SYB
+import qualified Data.List.Extra
+import qualified Data.Map                      as Map
 import qualified GHC
 import           GHC                            ( AddEpAnn(AddEpAnn)
                                                 , Anchor(Anchor)
@@ -64,82 +67,119 @@ import qualified Language.Haskell.GHC.ExactPrint.Types
 import qualified Language.Haskell.GHC.ExactPrint.Utils
                                                as ExactPrint
 import           Safe                           ( maximumMay )
+import qualified Control.Monad.Trans.Writer.Strict
+                                               as WriterS
 
 import           Language.Haskell.Brittany.Internal.Components.BriDoc
 import           Language.Haskell.Brittany.Internal.ToBriDoc.Module
 import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.Util.AST
 
 
 
-splitModule
-  :: Bool
-  -> GHC.ParsedSource
-  -> Maybe GHC.RealSrcLoc
-  -> FinalList ModuleElement ExactPrint.Pos
-splitModule shouldReformatHead lmod posWhere = do
-  let L moduleSpan modl          = lmod
-      HsModule _ _layout _name _exports imports decls _ _ = modl
-      (hsModAnn', finalComments) = case GHC.hsmodAnn modl of
-        EpAnn a modAnns (EpaCommentsBalanced prior post) ->
-          (EpAnn a modAnns (EpaCommentsBalanced prior []), post)
-        _ -> (GHC.hsmodAnn modl, [])
-      moduleWithoutComments =
-        L moduleSpan modl { GHC.hsmodAnn = hsModAnn', GHC.hsmodDecls = [] }
-  lastSpan <- if shouldReformatHead
-    then do
-      finalYield $ MEPrettyModuleHead moduleWithoutComments
-      let locBeforeImports =
-            maximumMay 
-              $  [ realSrcSpanEnd $ anchor a
-                 | L a _ <- case hsModAnn' of
-                   EpAnn _ _ (EpaComments cs             ) -> cs
-                   EpAnn _ _ (EpaCommentsBalanced cs1 cs2) -> cs1 ++ cs2
-                   EpAnnNotUsed -> error "unexpected EpAnnNotUsed"
-                 ]
-              ++ [ pos | Just pos <- [posWhere] ]
-      let (importLines, lastSpan) = finalToList $ transformToImportLine
-            ( maybe 0 srcLocLine locBeforeImports
-            , maybe 1 srcLocCol  locBeforeImports
-            )
-            imports
-      let commentedImports = groupifyImportLines importLines
-      sortCommentedImports commentedImports `forM_` \case
-        EmptyLines n ->
-          finalYield $ MEWhitespace $ DifferentLine n 1
-        SamelineComment{} ->
-          error "brittany internal error: splitModule SamelineComment"
-        NewlineComment  comm   -> finalYield $ MEComment comm
-        ImportStatement record -> do
-          forM_ (commentsBefore record) $ finalYield . MEComment
-          finalYield
-            $ MEImportDecl (importStatement record) (commentsSameline record)
-          forM_ (commentsAfter record) $ finalYield . MEComment
-      pure $ lastSpan
-    else do
-      finalYield $ MEExactModuleHead moduleWithoutComments
-      pure
-        $  maybe (1, 1) (ExactPrint.ss2posEnd)
-        $  maximumMay
-        $  [ GHC.anchor a
-           | L a _ <- GHC.priorComments $ case hsModAnn' of
-             EpAnn _ _ cs -> cs
-             EpAnnNotUsed -> error "unexpected EpAnnNotUsed"
-           ]
-        ++ [ s | AddEpAnn _ (EpaSpan s) <- GHC.am_main $ GHC.anns hsModAnn' ]
-        ++ [ GHC.anchor a
-           | L da _ <- GHC.hsmodImports modl
-           , L a  _ <- case GHC.ann da of
-             EpAnn _ _ (EpaComments l          ) -> l
-             EpAnn _ _ (EpaCommentsBalanced _ l) -> l
-             EpAnnNotUsed                        -> []
-           ]
-        ++ [ span
-           | L (SrcSpanAnn _ (GHC.RealSrcSpan span _)) _ <- GHC.hsmodImports
-             modl
-           ]
-  spanAfterDecls <- enrichDecls lastSpan decls
+extractDeclMap :: GHC.ParsedSource -> Map GHC.RealSrcSpan [String]
+extractDeclMap modul =
+  Map.fromList
+    [ ( case span of
+          GHC.RealSrcSpan s _ -> s
+          GHC.UnhelpfulSpan _ -> error "unexpected UnhelpfulSpan"
+      , getDeclBindingNames decl
+      )
+    | decl <- decls
+    , let (L (GHC.SrcSpanAnn _ span) _) = decl
+    ]
+  where (L _ (GHC.HsModule _ _ _ _ _ decls _ _)) = modul
+
+splitModuleDecls :: GHC.ParsedSource -> FinalList ModuleElement ExactPrint.Pos
+splitModuleDecls lmod = do
+  let
+    L moduleSpan modl          = lmod
+    HsModule _ _layout _name _exports imports decls _ _ = modl
+    (hsModAnn', finalComments) = case GHC.hsmodAnn modl of
+      EpAnn a modAnns (EpaCommentsBalanced prior post) ->
+        (EpAnn a modAnns (EpaCommentsBalanced prior []), post)
+      _ -> (GHC.hsmodAnn modl, [])
+    (newImports, commsAfterImports) = case Data.List.Extra.unsnoc imports of
+      Just (allButLast, L (SrcSpanAnn epAnn s@(RealSrcSpan span _)) lastImp) ->
+        case epAnn of
+          EpAnnNotUsed -> (imports, [])
+          EpAnn anch anns (EpaComments cs) ->
+            let
+              (keepImports, moveImports) =
+                partition
+                  (\(L cAnch _) ->
+                    GHC.srcSpanEndLine (anchor cAnch) <= GHC.srcSpanEndLine span
+                  )
+                  cs
+              newLastImport =
+                L (SrcSpanAnn (EpAnn anch anns (EpaComments keepImports)) s)
+                  lastImp
+            in
+              ( allButLast ++ [newLastImport]
+              , List.sortOn (\(L l _) -> l) moveImports
+              )
+          EpAnn anch anns (EpaCommentsBalanced cs1 cs2) ->
+            let newLastImport =
+                  L (SrcSpanAnn (EpAnn anch anns (EpaComments cs1)) s) lastImp
+            in  (allButLast ++ [newLastImport], List.sortOn (\(L l _) -> l) cs2)
+      _ -> ([], [])
+    moduleWithoutComments = L moduleSpan modl { GHC.hsmodAnn     = hsModAnn'
+                                              , GHC.hsmodDecls   = []
+                                              , GHC.hsmodImports = newImports
+                                              }
+  spanAfterImports <- do
+    finalYield $ MEExactModuleHead moduleWithoutComments
+    pure
+      $  maybe (0, 1) (ExactPrint.ss2posEnd)
+      $  maximumMay
+      $  [ GHC.anchor a
+         | L a _ <- GHC.priorComments $ case hsModAnn' of
+           EpAnn _ _ cs -> cs
+           EpAnnNotUsed -> error "unexpected EpAnnNotUsed"
+         ]
+      ++ [ s | AddEpAnn _ (EpaSpan s) <- GHC.am_main $ GHC.anns hsModAnn' ]
+      ++ [ span
+         | L (SrcSpanAnn _ (RealSrcSpan span _)) _ <- GHC.hsmodImports modl
+         ]
+      ++ [ span
+         | L (SrcSpanAnn _ (GHC.RealSrcSpan span _)) _ <- GHC.hsmodImports modl
+         ]
+  spanBeforeDecls <- enrichComms spanAfterImports commsAfterImports
+  spanAfterDecls  <- enrichDecls spanBeforeDecls decls
   enrichComms spanAfterDecls finalComments
 
+splitModuleStart
+  :: GHC.ParsedSource
+  -> Maybe GHC.RealSrcLoc
+  -> FinalList ModuleElement ExactPrint.Pos
+splitModuleStart modul posWhere = do
+  finalYield $ MEPrettyModuleHead modul
+  let locBeforeImports =
+        maximumMay
+          $  [ realSrcSpanEnd $ anchor a
+             | L a _ <- case GHC.hsmodAnn $ unLoc modul of
+               EpAnn _ _ (EpaComments cs             ) -> cs
+               EpAnn _ _ (EpaCommentsBalanced cs1 cs2) -> cs1 ++ cs2
+               EpAnnNotUsed -> error "unexpected EpAnnNotUsed"
+             ]
+          ++ [ pos | Just pos <- [posWhere] ]
+  let (importLines, lastSpan) = finalToList $ transformToImportLine
+        ( maybe 0 srcLocLine locBeforeImports
+        , maybe 1 srcLocCol  locBeforeImports
+        )
+        (GHC.hsmodImports $ unLoc modul)
+  let commentedImports = groupifyImportLines importLines
+  sortCommentedImports commentedImports `forM_` \case
+    EmptyLines n -> finalYield $ MEWhitespace $ DifferentLine n 1
+    SamelineComment{} ->
+      error "brittany internal error: splitModuleStart SamelineComment"
+    NewlineComment  comm   -> finalYield $ MEComment comm
+    ImportStatement record -> do
+      forM_ (commentsBefore record) $ finalYield . MEComment
+      finalYield $ MEImportDecl (importStatement record)
+                                (commentsSameline record)
+      forM_ (commentsAfter record) $ finalYield . MEComment
+  pure $ lastSpan
 
 enrichComms
   :: ExactPrint.Pos -> [LEpaComment] -> FinalList ModuleElement ExactPrint.Pos
@@ -150,60 +190,46 @@ enrichComms lastSpanEnd = \case
       SameLine i        -> SameLine i
       DifferentLine l c -> DifferentLine (l - 1) c
     enrichComms (ExactPrint.ss2posEnd span) commRest
-  (L (Anchor span _) (EpaComment comm _) : commRest) -> do
+  lcomm@(L (Anchor span _) _) : commRest -> do
     case ExactPrint.ss2delta lastSpanEnd span of
       SameLine i -> do
-        finalYield $ MEComment (i, comm)
+        finalYield $ MEComment (i, lcomm)
       DifferentLine l c -> do
         finalYield $ MEWhitespace $ DifferentLine (l - 1) c
-        finalYield $ MEComment (0, comm)
+        finalYield $ MEComment (0, lcomm)
     enrichComms (ExactPrint.ss2posEnd span) commRest
 
 enrichDecls
   :: ExactPrint.Pos -> [LHsDecl GhcPs] -> FinalList ModuleElement ExactPrint.Pos
 enrichDecls lastSpanEnd = \case
   [] -> finalPure $ lastSpanEnd
-  L (SrcSpanAnn dAnn rlspan@(GHC.RealSrcSpan span _)) decl : declRest ->
+  ldecl@(L (SrcSpanAnn dAnn (GHC.RealSrcSpan span _)) _) : declRest ->
     case dAnn of
-      EpAnn dAnchor items (EpaComments dComments) -> do
+      EpAnn _dAnchor _items (EpaComments _dComments) -> do
         let
-          (innerComments, outerComments) =
-            partition
-              (\(L (Anchor anch _) _) ->
-                realSrcSpanStart anch < realSrcSpanEnd span
-              )
-              dComments
-          withoutOuterComments =
-            (L
-              (SrcSpanAnn (EpAnn dAnchor items (EpaComments innerComments))
-                          rlspan
-              )
-              decl
-            )
-          commentExtract = \case
-            L (GHC.Anchor anch _) EpaComment{} -> ExactPrint.ss2posEnd anch
-          -- It would be really nice if `ExactPrint.ss2posEnd span` was
-          -- sufficient. But for some reason the comments are not
-          -- (consistently) included in the length of the anchor. I.e.
-          -- there are cases where a syntax tree node has an anchor from
-          -- pos A -> pos B. But then somewhere _below_ that node is a
-          -- comment that has an anchor pos B -> pos C.
-          -- We simply detect this here.
-          -- We probably do some redundant `SYB.everything` lookups
-          -- throughout the code now. But optimizing it is not easy, and
-          -- at worst it is larger constant factor on the size of the
-          -- input, so it isn't _that_ bad.
-          fixedSpanEnd =
-            SYB.everything
-              max
-              (SYB.mkQ (ExactPrint.ss2posEnd span) commentExtract)
-              decl
+          commentExtract
+            :: [LEpaComment] -> WriterS.Writer [LEpaComment] [LEpaComment]
+          commentExtract comms = do
+            let (innerComments, outerComments) =
+                  partition
+                    (\(L (Anchor anch _) _) ->
+                      (  realSrcSpanStart anch < realSrcSpanEnd span
+                      && realSrcSpanEnd anch > realSrcSpanStart span
+                      )
+                    )
+                    comms
+            WriterS.tell outerComments
+            pure innerComments
+          (ldecl', extractedComments) = WriterS.runWriter
+            $ SYB.everywhereM (SYB.mkM commentExtract) ldecl
         case ExactPrint.ss2delta lastSpanEnd span of
           SameLine{} -> pure ()
           DifferentLine n _ ->
             finalYield $ MEWhitespace $ DifferentLine (n - 1) 1
+        let fixedSpanEnd = ExactPrint.ss2posEnd span
         let (afterComms, span2) = finalToList
-              $ enrichComms fixedSpanEnd (reverse outerComments)
+              $ enrichComms fixedSpanEnd
+                            (List.sortOn (\(L l _) -> l) extractedComments)
         let (immediate, later) =
               List.span
                 (\case
@@ -212,8 +238,9 @@ enrichDecls lastSpanEnd = \case
                 )
                 afterComms
         finalYield
-          $ MEDecl withoutOuterComments [ comm | MEComment comm <- immediate ]
-          -- $ MEDecl ldecl []
+          $ MEDecl
+            ldecl'
+            [ (ind, GHC.ac_tok comm) | MEComment (ind, L _ comm) <- immediate ]
         later `forM_` finalYield
         enrichDecls span2 declRest
       EpAnn _anchor _items (EpaCommentsBalanced{}) ->
@@ -227,8 +254,8 @@ enrichDecls lastSpanEnd = \case
 
 data ImportLine
   = EmptyLines Int
-  | SamelineComment (Int, EpaCommentTok)
-  | NewlineComment  (Int, EpaCommentTok) -- indentation and comment
+  | SamelineComment (Int, LEpaComment)
+  | NewlineComment  (Int, LEpaComment) -- indentation and comment
   | ImportStatement ImportStatementRecord
 
 instance Show ImportLine where
@@ -241,10 +268,10 @@ instance Show ImportLine where
         (length $ commentsAfter r)
 
 data ImportStatementRecord = ImportStatementRecord
-  { commentsBefore   :: [(Int, EpaCommentTok)]
+  { commentsBefore   :: [(Int, LEpaComment)]
   , importStatement  :: LImportDecl GhcPs
   , commentsSameline :: [(Int, EpaCommentTok)]
-  , commentsAfter    :: [(Int, EpaCommentTok)]
+  , commentsAfter    :: [(Int, LEpaComment)]
   }
 
 instance Show ImportStatementRecord where
@@ -263,13 +290,13 @@ transformToImportLine startPos is =
       :: [LEpaComment] -> ExactPrint.Pos -> FinalList ImportLine ExactPrint.Pos
     flattenComms = \case
       [] -> finalPure
-      (L (Anchor span _) (EpaComment comm _) : commRest) -> \lastSpanEnd -> do
+      lcomm@(L (Anchor span _) _) : commRest -> \lastSpanEnd -> do
         case ExactPrint.ss2delta lastSpanEnd span of
           SameLine i -> do
-            finalYield $ SamelineComment (i, comm)
+            finalYield $ SamelineComment (i, lcomm)
           DifferentLine l c -> do
             finalYield $ EmptyLines (l - 1)
-            finalYield $ NewlineComment (c - 1, comm)
+            finalYield $ NewlineComment (c - 1, lcomm)
         flattenComms commRest (ExactPrint.ss2posEnd span)
     flattenDecls
       :: [LImportDecl GhcPs]
@@ -278,43 +305,41 @@ transformToImportLine startPos is =
     flattenDecls = \case
       [] -> finalPure
       (L (SrcSpanAnn epAnn srcSpan@(RealSrcSpan declSpan _)) decl : declRest)
-        -> \lastSpanEnd ->
+         -> \lastSpanEnd ->
           let (commsBefore, commsAfter, cleanEpAnn) = case epAnn of
                 EpAnn anch s (EpaComments cs) ->
                   ([], reverse cs, EpAnn anch s (EpaComments []))
                 EpAnn anch s (EpaCommentsBalanced cs1 cs2) ->
                   (reverse cs1, reverse cs2, EpAnn anch s (EpaComments []))
                 EpAnnNotUsed -> ([], [], EpAnnNotUsed)
-          in
-            do
-              span1 <- flattenComms commsBefore lastSpanEnd
-              let newlines = case ExactPrint.ss2delta span1 declSpan of
-                    SameLine _        -> 0
-                    DifferentLine i _ -> i - 1
-              finalYield
-                $ EmptyLines newlines
-              finalYield $ ImportStatement ImportStatementRecord
-                { commentsBefore   = []
-                , importStatement  = L (SrcSpanAnn cleanEpAnn srcSpan) decl
-                , commentsSameline = []
-                , commentsAfter    = []
-                }
-              span2 <- flattenComms commsAfter (ExactPrint.ss2posEnd declSpan)
-              flattenDecls declRest span2
+          in  do
+                span1 <- flattenComms commsBefore lastSpanEnd
+                let newlines = case ExactPrint.ss2delta span1 declSpan of
+                      SameLine _        -> 0
+                      DifferentLine i _ -> i - 1
+                finalYield $ EmptyLines newlines
+                finalYield $ ImportStatement ImportStatementRecord
+                  { commentsBefore   = []
+                  , importStatement  = L (SrcSpanAnn cleanEpAnn srcSpan) decl
+                  , commentsSameline = []
+                  , commentsAfter    = []
+                  }
+                span2 <- flattenComms commsAfter (ExactPrint.ss2posEnd declSpan)
+                flattenDecls declRest span2
       (L (SrcSpanAnn _epAnn UnhelpfulSpan{}) _decl : _declRest) ->
         error "UnhelpfulSpan"
   in
     flattenDecls is startPos
 
-data Partial = PartialCommsOnly [(Int, EpaCommentTok)]
+data Partial = PartialCommsOnly [(Int, LEpaComment)]
              | PartialImport ImportStatementRecord
 
 groupifyImportLines :: [ImportLine] -> [ImportLine]
 groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
  where
   go acc [] = case acc of
-    PartialCommsOnly comms ->
-      reverse comms `forM_` \comm -> finalYield $ NewlineComment comm
+    PartialCommsOnly comms -> reverse comms `forM_` \comm ->
+      finalYield $ NewlineComment comm
     PartialImport partialRecord ->
       finalYield $ ImportStatement $ unpartial partialRecord
   go acc (line1 : lineR) = do
@@ -326,9 +351,10 @@ groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
           pure $ PartialCommsOnly []
         SamelineComment comm -> do
           pure $ PartialCommsOnly (comm : comms)
-        NewlineComment comm -> pure $ PartialCommsOnly (comm : comms)
-        ImportStatement record ->
-          pure $ PartialImport $ record { commentsBefore = comms }
+        NewlineComment  comm   -> pure $ PartialCommsOnly (comm : comms)
+        ImportStatement record -> pure $ PartialImport $ record
+          { commentsBefore = comms
+          }
       PartialImport partialRecord -> case line1 of
         e@EmptyLines{} -> do
           finalYield $ ImportStatement $ unpartial partialRecord
@@ -337,7 +363,8 @@ groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
         SamelineComment comm -> do
           if (null $ commentsAfter partialRecord)
             then pure $ PartialImport partialRecord
-              { commentsSameline = comm : commentsSameline partialRecord
+              { commentsSameline = tokenOnly comm
+                                   : commentsSameline partialRecord
               }
             else pure $ PartialImport partialRecord
               { commentsAfter = comm : commentsAfter partialRecord
@@ -353,6 +380,8 @@ groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
           pure $ PartialImport $ record { commentsBefore = contestedComments }
             -- comments in between will stay connected to the following decl
     go newAcc lineR
+  tokenOnly :: (Int, LEpaComment) -> (Int, EpaCommentTok)
+  tokenOnly (ind, L _ (EpaComment tok _)) = (ind, tok)
   unpartial :: ImportStatementRecord -> ImportStatementRecord
   unpartial partialRecord = ImportStatementRecord
     { commentsBefore   = reverse (commentsBefore partialRecord)
@@ -365,7 +394,7 @@ groupifyImportLines ls = finalToList_ $ go (PartialCommsOnly []) ls
 sortCommentedImports :: [ImportLine] -> [ImportLine]
 sortCommentedImports =
   -- TODO92 we don't need this unpackImports, it is implied later in the process
-                       mergeGroups . map (fmap (sortGroups)) . groupify
+  mergeGroups . map (fmap (sortGroups)) . groupify
  where
   -- unpackImports :: [ImportLine] -> [ImportLine]
   -- unpackImports xs = xs >>= \case
@@ -381,8 +410,8 @@ sortCommentedImports =
     Left  x -> [x]
     Right y -> ImportStatement <$> y
   sortGroups :: [ImportStatementRecord] -> [ImportStatementRecord]
-  sortGroups =
-    List.sortOn (moduleNameString . unLoc . ideclName . unLoc . importStatement)
+  sortGroups = List.sortOn
+    (moduleNameString . unLoc . ideclName . unLoc . importStatement)
   groupify :: [ImportLine] -> [Either ImportLine [ImportStatementRecord]]
   groupify cs = go [] cs
    where

source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE DataKinds #-}
 
 module Language.Haskell.Brittany.Internal.StepOrchestrate
   ( processModule
-  )
-where
+  ) where
 
 import           Language.Haskell.Brittany.Internal.Prelude
 
@@ -15,7 +15,8 @@ import qualified Data.Text.Lazy                as TextL
 import qualified Data.Text.Lazy.Builder        as TextL.Builder
 import qualified Data.Text.Lazy.Builder        as Text.Builder
 import qualified GHC
-import           GHC                            ( EpaCommentTok
+import           GHC                            ( EpaComment(EpaComment)
+                                                , EpaCommentTok
                                                   ( EpaBlockComment
                                                   , EpaEofComment
                                                   , EpaLineComment
@@ -36,7 +37,7 @@ import           Language.Haskell.Brittany.Internal.Config.Types
 import           Language.Haskell.Brittany.Internal.Config.Types.Instances2
                                                 ( )
 import           Language.Haskell.Brittany.Internal.S2_SplitModule
-                                                ( splitModule )
+                                                ( splitModuleStart )
 import           Language.Haskell.Brittany.Internal.S3_ToBriDocTools
 import           Language.Haskell.Brittany.Internal.S4_WriteBriDoc
                                                 ( ppBriDoc )
@@ -46,7 +47,8 @@ import           Language.Haskell.Brittany.Internal.ToBriDoc.Module
 import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Util.AST
 import           Language.Haskell.Brittany.Internal.Utils
-import           Language.Haskell.Brittany.Internal.ToBriDoc (layouters)
+import           Language.Haskell.Brittany.Internal.ToBriDoc
+                                                ( layouters )
 
 
 
@@ -58,86 +60,26 @@ processModule
   :: TraceFunc
   -> Config
   -> PerItemConfig
-  -> GHC.ParsedSource
+  -> FinalList ModuleElement p
   -> IO ([BrittanyError], TextL.Text)
-processModule traceFunc conf inlineConf parsedModule = do
-  let shouldReformatHead =
-        conf & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
-  let
-    wrapNonDeclToBriDoc = MultiRWSS.withMultiReader conf
-      . MultiRWSS.withMultiState_ (CommentCounter 0)
-    FinalList moduleElementsStream = splitModule
-      shouldReformatHead
-      parsedModule
-      (fmap GHC.realSrcSpanStart $ obtainAnnPos (GHC.hsmodAnn $ GHC.unLoc parsedModule) GHC.AnnWhere)
-    ((out, errs), debugStrings) =
-      runIdentity
-        $ MultiRWSS.runMultiRWSTNil
-        $ MultiRWSS.withMultiWriterAW
-        $ MultiRWSS.withMultiWriterAW
-        $ MultiRWSS.withMultiWriterW
-        $ MultiRWSS.withMultiReader traceFunc
-        $ moduleElementsStream
-            (\modElem cont -> do
-              case modElem of
-                MEExactModuleHead modHead -> wrapNonDeclToBriDoc $ do
-                  bdMay <- ppModuleHead modHead
-                  case bdMay of
-                    Nothing -> pure ()
-                    Just bd -> ppBriDoc bd True
-                MEPrettyModuleHead (L loc modHead) -> wrapNonDeclToBriDoc $ do
-                  case modHead of
-                    HsModule epAnn _layoutInfo Nothing Nothing _ _ _ _ -> do
-                      (bd, _) <-
-                        briDocMToPPM layouters
-                        $ maybe id
-                                docFlushRemaining
-                                (srcSpanFileName_maybe loc)
-                        $ docHandleComms epAnn docSeparator
-                      ppBriDoc bd True
-                    HsModule _ _layoutInfo Nothing Just{} _ _ _ _ -> error
-                      "brittany internal error: exports without module name"
-                    HsModule epAnn _layoutInfo (Just n) les _ _ _ _ -> do
-                      (bd, _) <-
-                        briDocMToPPM layouters
-                        $ maybe id
-                                docFlushRemaining
-                                (srcSpanFileName_maybe loc)
-                        $ moduleNameExportBridoc epAnn n les
-                      ppBriDoc bd True
-                MEImportDecl importDecl immediateAfterComms ->
-                  wrapNonDeclToBriDoc $ do
-                    (bd, _) <-
-                      briDocMToPPM layouters
-                        $ docSeq
-                            ( layoutImport importDecl
-                            : map commentToDoc immediateAfterComms
-                            )
-                    ppBriDoc bd False
-                MEDecl decl immediateAfterComms -> do
-                  let declConfig = getDeclConfig conf inlineConf decl
-                  MultiRWSS.withMultiReader declConfig
-                    $ MultiRWSS.withMultiState_ (CommentCounter 0)
-                    $ ppToplevelDecl decl immediateAfterComms
-                MEComment (ind, EpaLineComment str) -> do
-                  mTell $ TextL.Builder.fromString (replicate ind ' ' ++ str)
-                  mTell $ TextL.Builder.fromString "\n"
-                MEComment (ind, EpaBlockComment str) -> do
-                  mTell $ TextL.Builder.fromString (replicate ind ' ' ++ str)
-                  mTell $ TextL.Builder.fromString "\n"
-                MEComment (_, EpaEofComment) -> pure ()
-                MEComment _ ->
-                  mTell $ TextL.Builder.fromString "some other comment"
-                MEWhitespace dp -> do
-                  -- mTell $ TextL.Builder.fromString "B"
-                  -- mTell $ TextL.Builder.fromString ("whitespace " ++ show dp)
-                  ppmMoveToExactLoc dp
-              cont
-            )
-            (\x -> do
+processModule traceFunc conf inlineConf moduleElems = do
+  let FinalList moduleElementsStream = moduleElems
+      ((out, errs), debugStrings) =
+        runIdentity
+          $ MultiRWSS.runMultiRWSTNil
+          $ MultiRWSS.withMultiWriterAW
+          $ MultiRWSS.withMultiWriterAW
+          $ MultiRWSS.withMultiWriterW
+          $ MultiRWSS.withMultiReader traceFunc
+          $ moduleElementsStream
+              (\modElem cont -> do
+                processModuleElement modElem
+                cont
+              )
+              (\x -> do
               -- mTell $ TextL.Builder.fromString "\n"
-              pure x
-            )
+                pure x
+              )
     -- _tracer = 
     --   -- if Seq.null debugStrings
     --   -- then id
@@ -151,14 +93,94 @@ processModule traceFunc conf inlineConf parsedModule = do
   --       MEExactModuleHead{}  -> useTraceFunc traceFunc "MEExactModuleHead"
   --       MEPrettyModuleHead{} -> useTraceFunc traceFunc "MEPrettyModuleHead"
   --       MEImportDecl{}       -> useTraceFunc traceFunc "MEImportDecl"
-  --       MEDecl decl _        -> useTraceFunc traceFunc ("MEDecl " ++ intercalate "," (getDeclBindingNames decl))
-  --       MEComment (y, EpaLineComment str) -> useTraceFunc traceFunc ("MEComment " ++ show y ++ " " ++ str)
-  --       MEComment (y, _) -> useTraceFunc traceFunc ("MEComment " ++ show y ++ " _")
+  --       MEDecl decl _ ->
+  --         useTraceFunc
+  --           traceFunc
+  --           ("MEDecl " ++ intercalate "," (getDeclBindingNames decl))
+  --       MEComment (y, L _ (EpaComment (EpaLineComment str) _)) ->
+  --         useTraceFunc traceFunc ("MEComment " ++ show y ++ " " ++ str)
+  --       MEComment (y, L _ (EpaComment (EpaBlockComment str) _)) ->
+  --         useTraceFunc traceFunc ("MEComment " ++ show y ++ " " ++ take 5 str)
+  --       MEComment (y, _) ->
+  --         useTraceFunc traceFunc ("MEComment " ++ show y ++ " _")
   --       MEWhitespace dp -> useTraceFunc traceFunc ("MEWhitespace " ++ show dp)
   --     rest
   --   )
   --   (\_ -> pure ())
   pure (errs, TextL.Builder.toLazyText out)
+ where
+  shouldReformatHead =
+    conf & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
+  wrapNonDeclToBriDoc =
+    MultiRWSS.withMultiReader conf . MultiRWSS.withMultiState_
+      (CommentCounter 0)
+  processModuleElement
+    :: ModuleElement
+    -> MultiRWSS.MultiRWST
+         '[TraceFunc]
+         '[Text.Builder.Builder , [BrittanyError] , Seq String]
+         '[]
+         Identity
+         ()
+  processModuleElement = \case
+    MEExactModuleHead modHead -> if shouldReformatHead
+      then do
+        let FinalList startElems =
+              splitModuleStart
+                modHead
+                ( fmap GHC.realSrcSpanStart
+                $ obtainAnnPos (GHC.hsmodAnn $ GHC.unLoc modHead) GHC.AnnWhere
+                )
+        startElems
+          (\modElem cont -> do
+            processModuleElement modElem
+            cont
+          )
+          (\_ -> pure ())
+      else wrapNonDeclToBriDoc $ do
+        bdMay <- ppModuleHead modHead
+        case bdMay of
+          Nothing -> pure ()
+          Just bd -> do
+            ppBriDoc bd True
+        mTell $ Text.Builder.fromString "\n"
+    MEPrettyModuleHead (L loc modHead) -> wrapNonDeclToBriDoc $ do
+      case modHead of
+        HsModule epAnn _layoutInfo Nothing Nothing _ _ _ _ -> do
+          (bd, _) <-
+            briDocMToPPM layouters
+            $ maybe id docFlushRemaining (srcSpanFileName_maybe loc)
+            $ docHandleComms epAnn docSeparator
+          ppBriDoc bd True
+        HsModule _ _layoutInfo Nothing Just{} _ _ _ _ ->
+          error "brittany internal error: exports without module name"
+        HsModule epAnn _layoutInfo (Just n) les _ _ _ _ -> do
+          (bd, _) <-
+            briDocMToPPM layouters
+            $ maybe id docFlushRemaining (srcSpanFileName_maybe loc)
+            $ moduleNameExportBridoc epAnn n les
+          ppBriDoc bd True
+    MEImportDecl importDecl immediateAfterComms -> wrapNonDeclToBriDoc $ do
+      (bd, _) <- briDocMToPPM layouters $ docSeq
+        (layoutImport importDecl : map commentToDoc immediateAfterComms)
+      ppBriDoc bd False
+    MEDecl decl immediateAfterComms -> do
+      let declConfig = getDeclConfig conf inlineConf decl
+      MultiRWSS.withMultiReader declConfig
+        $ MultiRWSS.withMultiState_ (CommentCounter 0)
+        $ ppToplevelDecl decl immediateAfterComms
+    MEComment (ind, L _ (EpaComment (EpaLineComment str) _)) -> do
+      mTell $ TextL.Builder.fromString (replicate ind ' ' ++ str)
+      mTell $ TextL.Builder.fromString "\n"
+    MEComment (ind, L _ (EpaComment (EpaBlockComment str) _)) -> do
+      mTell $ TextL.Builder.fromString (replicate ind ' ' ++ str)
+      mTell $ TextL.Builder.fromString "\n"
+    MEComment (_, L _ (EpaComment EpaEofComment _)) -> pure ()
+    MEComment    _  -> mTell $ TextL.Builder.fromString "some other comment"
+    MEWhitespace dp -> do
+      -- mTell $ TextL.Builder.fromString "B"
+      -- mTell $ TextL.Builder.fromString ("whitespace " ++ show dp)
+      ppmMoveToExactLoc dp
 
 commentToDoc :: (Int, EpaCommentTok) -> ToBriDocM BriDocNumbered
 commentToDoc (indent, c) = case c of
@@ -198,17 +220,13 @@ processDefault x = do
     _    -> mTell $ Text.Builder.fromString $ List.dropWhileEnd ((==) '\n') str
 
 
-getDeclConfig
-  :: Config
-  -> PerItemConfig
-  -> GHC.LHsDecl GhcPs
-  -> Config
+getDeclConfig :: Config -> PerItemConfig -> GHC.LHsDecl GhcPs -> Config
 getDeclConfig config inlineConf decl = cZipWith fromOptionIdentity config
   $ mconcat (catMaybes (mBindingConfs ++ [mDeclConf]))
  where
   declBindingNames = getDeclBindingNames decl
-  mBindingConfs =
-    declBindingNames <&> \n -> Map.lookup n $ _icd_perBinding inlineConf
+  mBindingConfs    = declBindingNames <&> \n ->
+    Map.lookup n $ _icd_perBinding inlineConf
   mDeclConf = case GHC.locA $ GHC.getLoc decl of
     GHC.RealSrcSpan x _ -> Map.lookup x $ _icd_perAnchor inlineConf
     GHC.UnhelpfulSpan{} -> Nothing
@@ -218,16 +236,15 @@ ppToplevelDecl decl immediateAfterComms = do
   exactprintOnly <- mAsk <&> \declConfig ->
     declConfig & _conf_roundtrip_exactprint_only & confUnpack
   bd <- fmap fst $ if exactprintOnly
-    then briDocMToPPM layouters
-      $ docSeq
-        (briDocByExactNoComment decl : map commentToDoc immediateAfterComms)
+    then briDocMToPPM layouters $ docSeq
+      (briDocByExactNoComment decl : map commentToDoc immediateAfterComms)
     else do
       let innerDoc = case decl of
             L (SrcSpanAnn _ (GHC.RealSrcSpan s _)) _ ->
               docFlushRemaining (GHC.srcSpanFile s) $ layoutDecl decl
             _ -> layoutDecl decl
-      (r, errorCount) <- briDocMToPPM layouters
-        $ docSeq (innerDoc : map commentToDoc immediateAfterComms)
+      (r, errorCount) <- briDocMToPPM layouters $ docSeq
+        (innerDoc : map commentToDoc immediateAfterComms)
       if errorCount == 0
         then pure (r, 0)
         else briDocMToPPM layouters $ briDocByExactNoComment decl

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/DataDecl.hs

@@ -494,7 +494,7 @@ createDetailsDoc consNameStr details = case details of
               ]
             , docSeq
               [ docHandleComms posOpen $ docLitS "{"
-              , docSeparator
+              , docHandleComms epAnn docSeparator
               , docSetBaseY $ docAddBaseY BrIndentRegular $ docPar
                 fName1
                 (docSeq [docLitS "::", docSeparator, fType1])

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Decl.hs

@@ -641,29 +641,36 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauses (wrapBinds, mWhe
             $ docLines
             $ map docSetBaseY
             $ clauseDocs
-            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> -- TODO92
-                  (case guardDocs of
-                      [] -> [docHandleComms grhsEpAnn docEmpty]
-                      [g] ->
-                        [ docHandleComms grhsEpAnn
-                        $ docSeq [appSep
-                        $ docLit $ Text.pack "|", return g]
-                        ]
-                      (g1 : gr) ->
-                        ( ( docHandleComms grhsEpAnn
-                          $ docSeq [appSep $ docLit $ Text.pack "|", return g1]
-                          )
-                        : (gr <&> \g ->
-                            docSeq [appSep $ docLit $ Text.pack ",", return g]
-                          )
-                        )
-                    )
-                    ++ [ docCols
-                           ColOpPrefix
-                           [ appSep $ return binderDoc
-                           , docAddBaseY BrIndentRegular $ return bodyDoc
-                           ]
-                       ]
+            >>= \(grhsEpAnn, guardDocs, bodyDoc) -> case guardDocs of
+              [] ->
+                [ docHandleComms grhsEpAnn
+                $ docCols
+                  ColOpPrefix
+                  [ appSep $ return binderDoc
+                  , docAddBaseY BrIndentRegular $ return bodyDoc
+                  ]
+                ]
+              [g] ->
+                [ docHandleComms grhsEpAnn
+                  $ docSeq [appSep $ docLit $ Text.pack "|", return g]
+                , docSeq
+                  [ appSep $ return binderDoc
+                  , docAddBaseY BrIndentRegular $ return bodyDoc
+                  ]
+                ]
+              (g1 : gr) ->
+                (  [ docHandleComms grhsEpAnn
+                     $ docSeq [appSep $ docLit $ Text.pack "|", return g1]
+                   ]
+                ++ (gr <&> \g ->
+                     docSeq [appSep $ docLit $ Text.pack ",", return g]
+                   )
+                ++ [ docSeq
+                     [ appSep $ return binderDoc
+                     , docAddBaseY BrIndentRegular $ return bodyDoc
+                     ]
+                   ]
+                )
           ]
         ++ wherePartMultiLine
 

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs

@@ -124,19 +124,22 @@ layoutExpr lexpr@(L _ expr) = do
       docSetParSpacing
         $ docAddBaseY BrIndentRegular
         $ (docLit $ Text.pack "\\case {}")
-    HsLamCase _ (MG _ lmatches@(L _ matches) _) -> do
+    HsLamCase epAnn (MG _ lmatches@(L _ matches) _) -> do
       binderDoc   <- docLit $ Text.pack "->"
       layouters <- mAsk
       funcPatDocs <-
         layout_patternBind layouters Nothing binderDoc `mapM` matches
-      docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
-        (docLit $ Text.pack "\\case")
-        ( docSetBaseAndIndent
-        $ docNonBottomSpacing
-        $ docHandleComms lmatches
-        $ docLines
-        $ return <$> funcPatDocs
-        )
+      docSetParSpacing
+        $ docAddBaseY BrIndentRegular
+        $ docHandleComms epAnn
+        $ docPar
+          (docLit $ Text.pack "\\case")
+          ( docSetBaseAndIndent
+          $ docNonBottomSpacing
+          $ docHandleComms lmatches
+          $ docLines
+          $ return <$> funcPatDocs
+          )
     HsApp _ exp1 _ -> do
       let gather
             :: [(EpAnnCO, LHsExpr GhcPs)]
@@ -1015,7 +1018,7 @@ recordExpression dotdot wrapO wrapDD wrapC indentPolicy _lexpr nameDoc nameLayou
                   [AddCommaAnn span] -> Just $ epaLocationRealSrcSpanStart span
                   _                  -> Nothing
                 SrcSpanAnn EpAnnNotUsed _ -> Nothing
-          fnameDoc <- shareDoc $ nameLayouter nameThing
+          fnameDoc <- shareDoc $ docHandleComms fEpAnn $ nameLayouter nameThing
           if pun
             then pure $ Left (posStart, fnameDoc)
             else do

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs

@@ -245,16 +245,28 @@ layoutOpTree allowSinglelinePar = \case
           wrapParenMlIf x innerHead innerLines = if x
             then wrapParenMl innerHead innerLines
             else docPar innerHead (docLines innerLines)
-          wrapParenMl innerHead innerLines = docSetBaseY $ docLines
-            (  [ docCols
-                   ColOpPrefix
-                   [ (if zeroOps then id else appSep) $ docLit $ Text.pack "("
-                   , docHandleComms locO $ innerHead
-                   ]
-               ]
-            ++ innerLines
-            ++ [docHandleComms locC $ docLit $ Text.pack ")"]
-            )
+          wrapParenMl innerHead innerLines = docAlt
+            [ docForceZeroAdd $ docSetBaseY $ docLines
+              (  [ docCols
+                     ColOpPrefix
+                     [ (if zeroOps then id else appSep) $ docLit $ Text.pack "("
+                     , docHandleComms locO $ innerHead
+                     ]
+                 ]
+              ++ innerLines
+              ++ [docHandleComms locC $ docLit $ Text.pack ")"]
+              )
+            , docPar
+              (docCols
+                ColOpPrefix
+                [ (if zeroOps then id else appSep) $ docLit $ Text.pack "("
+                , docHandleComms locO $ innerHead
+                ]
+              )
+              ( docLines
+              $ innerLines ++ [docHandleComms locC $ docLit $ Text.pack ")"]
+              )
+            ]
 
       configAllowsParInsert <- askLayoutConf _lconfig_fixityBasedAddAlignParens
       let allowParIns = configAllowsParInsert && case fixity of

source/library/Language/Haskell/Brittany/Internal/Transformations/T1_Alt.hs

@@ -205,7 +205,7 @@ transformAlts =
         let ind = _acp_indent acp + _acp_indentPrep acp + indAdd
         mSet $ acp
           { _acp_indent = ind, _acp_indentPrep = 0
-          , _acp_indentPrepForced = False
+          , _acp_indentPrepForced = parentForced
           }
         sameLine' <- go sameLine
         mModify $ \acp' -> acp'

source/library/Language/Haskell/Brittany/Internal/Transformations/T4_Columns.hs

@@ -91,8 +91,8 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
       ]
   BDPar ind col1@(BDCols sig1 _) col2@(BDCols sig2 _) | sig1 == sig2 ->
     Just $ BDAddBaseY ind (BDLines [col1, col2])
-  BDPar ind col1@(BDCols sig1 _) (BDLines (col2@(BDCols sig2 _) : rest))
-    | sig1 == sig2 -> Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
+  -- BDPar ind col1@(BDCols sig1 _) (BDLines (col2@(BDCols sig2 _) : rest))
+  --   | sig1 == sig2 -> Just $ BDPar ind (BDLines [col1, col2]) (BDLines rest)
   BDPar ind (BDLines lines1) col2@(BDCols sig2 _)
     | BDCols sig1 _ <- List.last lines1, sig1 == sig2 -> Just
     $ BDAddBaseY ind (BDLines $ lines1 ++ [col2])
@@ -109,15 +109,13 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
     -> Just
       $ BDLines [BDCols sig1 (List.init cols ++ [line]), BDCols sig2 cols2]
   BDCols sig1 cols
-    | BDPar ind line (BDLines lines) <- List.last cols
-    , BDCols sig2 cols2 <- List.last lines
-    , sig1 == sig2
-    -> Just $ BDLines
-      [ BDCols sig1
-      $ List.init cols
-      ++ [BDPar ind line (BDLines $ List.init lines)]
-      , BDCols sig2 cols2
-      ]
+    | BDPar _ line (BDLines lines) <- List.last cols
+    , all (\case
+            BDCols sig2 _ -> sig1 == sig2
+            _ -> False
+          )
+          lines
+    -> Just $ BDLines $ BDCols sig1 (List.init cols ++ [line]) : lines
   BDLines [x] -> Just $ x
   BDLines [] -> Just $ BDEmpty
   BDSeq{} -> Nothing

source/library/Language/Haskell/Brittany/Internal/Transformations/T5_Indent.hs

@@ -44,6 +44,8 @@ transformSimplifyIndent = Uniplate.rewrite $ \case
     Just $ BDFlushCommentsPrior c (BDAddBaseY i x)
   BDAddBaseY i (BDFlushCommentsPost c sm x) ->
     Just $ BDFlushCommentsPost c sm (BDAddBaseY i x)
+  BDAddBaseY i (BDQueueComments comms x) ->
+    Just $ BDQueueComments comms (BDAddBaseY i x)
   BDAddBaseY i (BDSeq l) ->
     Just $ BDSeq $ List.init l ++ [BDAddBaseY i $ List.last l]
   BDAddBaseY i (BDCols sig l) ->

source/library/Language/Haskell/Brittany/Internal/Types.hs

@@ -24,6 +24,7 @@ import           GHC                            ( Anno
                                                 , ParsedSource
                                                 , XRec
                                                 , LImportDecl
+                                                , LEpaComment
                                                 )
 import GHC.Utils.Outputable(Outputable)
 import Language.Haskell.Brittany.Internal.Config.Types
@@ -89,6 +90,8 @@ finalToList_ :: FinalList a () -> [a]
 finalToList_ (FinalList l) = l (:) (\() -> [])
 finalToList :: FinalList a b -> ([a], b)
 finalToList (FinalList l) = l (\x (a, b) -> (x:a, b)) (\b -> ([], b))
+concatMapFinal :: FinalList a () -> (a -> [b]) -> [b]
+concatMapFinal (FinalList l) f = l (\x rest -> f x ++ rest) (\() -> [])
 
 instance Functor (FinalList a) where
   fmap = _finalRMap
@@ -119,7 +122,7 @@ data ModuleElement
     -- ^ an import decl, only occurs if pretty-printing the module head.
   | MEDecl (LHsDecl GhcPs) [(Int, EpaCommentTok)]
     -- ^ a top-level declaration
-  | MEComment (Int, EpaCommentTok)
+  | MEComment (Int, LEpaComment)
     -- ^ a top-level comment, i.e. a comment located between top-level elements
     --   (and not associated to some nested node, which might in theory happen).
     --   The Int carries the indentation of the comment.

source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs

@@ -25,6 +25,7 @@ where
 
 import Language.Haskell.Brittany.Internal.Prelude
 
+import qualified Data.Maybe
 import qualified Data.Text                     as Text
 import qualified Data.Text.Lazy.Builder        as Text.Builder
 import qualified GHC.OldList                   as List
@@ -157,7 +158,9 @@ layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't mo
         PlannedNewline l ->
           if l <= y then PlannedSameline 1 else PlannedNewline (l - y)
         PlannedDelta l i ->
-          if l <= y then PlannedSameline 1 else PlannedDelta (l - y) i
+          if l <= y && Data.Maybe.isNothing (_lstate_markerForDelta state)
+            then PlannedSameline 1
+            else PlannedDelta (l - y) i
       else case _lstate_plannedSpace state of
         PlannedNone        -> PlannedDelta 1 (_lstate_curY state)
         PlannedSameline i  -> PlannedDelta 1 (_lstate_curY state + i)

source/library/Language/Haskell/Brittany/Main.hs

@@ -381,9 +381,15 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
         putErrorLn left
         ExceptT.throwE 60
       Right (parsedSource, hasCPP) -> do
+        let moduleElementList = splitModuleDecls parsedSource
         (inlineConf, perItemConf) <- do
           resE <-
-            liftIO $ ExceptT.runExceptT $ extractCommentConfigs putErrorLnIO parsedSource
+            liftIO
+              $ ExceptT.runExceptT
+              $ extractCommentConfigs
+                putErrorLnIO
+                (extractDeclMap parsedSource)
+                moduleElementList
           case resE of
             Left (err, input) -> do
               putErrorLn $ "Error: parse error in inline configuration:"
@@ -414,9 +420,9 @@ coreIO putErrorLnIO config suppressOutput checkMode inputPathM outputPathM =
                     .> _econf_omit_output_valid_check
                     .> confUnpack
               (ews, outRaw) <- if hasCPP || omitCheck
-                then liftIO $ processModule (TraceFunc putErrorLnIO) moduleConf perItemConf parsedSource
+                then liftIO $ processModule (TraceFunc putErrorLnIO) moduleConf perItemConf moduleElementList
                 else liftIO
-                  $ pPrintModuleAndCheck (TraceFunc putErrorLnIO) moduleConf perItemConf parsedSource
+                  $ pPrintModuleAndCheck (TraceFunc putErrorLnIO) moduleConf perItemConf moduleElementList
               let
                 hackF s = fromMaybe s $ TextL.stripPrefix
                   (TextL.pack "-- BRITANY_INCLUDE_HACK ")