Add two config options to control preamble layouting

src-literatetests/Main.hs

@@ -174,6 +174,8 @@ defaultTestConfig = Config
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
     , _lconfig_hangingTypeSignature      = coerce False
+    , _lconfig_reformatModulePreamble    = coerce True
+    , _lconfig_allowSingleLineExportList = coerce True
     }
   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
     { _econf_omit_output_valid_check = coerce True

src-unittests/TestUtils.hs

@@ -56,6 +56,8 @@ defaultTestConfig = Config
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
     , _lconfig_hangingTypeSignature      = coerce False
+    , _lconfig_reformatModulePreamble    = coerce True
+    , _lconfig_allowSingleLineExportList = coerce True
     }
   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)
     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever

src/Language/Haskell/Brittany/Internal.hs

@@ -324,7 +324,7 @@ ppDecl d@(L loc decl) = case decl of
 -- This includes the imports
 ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
            -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
-ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
+ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do
   filteredAnns <- mAsk <&> \annMap ->
     Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
     -- Since ghc-exactprint adds annotations following (implicit)
@@ -332,11 +332,17 @@ ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
     -- this can cause duplication of comments. So strip
     -- attached annotations that come after the module's where
     -- from the module node
-  let (filteredAnns', post) =
+  config <- mAsk
+  let shouldReformatPreamble =
+        config & _conf_layout & _lconfig_reformatModulePreamble & confUnpack
+
+  let
+    (filteredAnns', post) =
       case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of
         Nothing -> (filteredAnns, [])
         Just mAnn ->
-            let modAnnsDp = ExactPrint.annsDP mAnn
+          let
+            modAnnsDp = ExactPrint.annsDP mAnn
             isWhere (ExactPrint.G AnnWhere) = True
             isWhere _                       = False
             isEof (ExactPrint.G AnnEofPos) = True
@@ -349,7 +355,7 @@ ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
               (Nothing, Just _i) -> ([], modAnnsDp)
               (Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
             findInitialCommentSize = \case
-                  ((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)):rest) ->
+              ((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)) : rest) ->
                 let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm
                 in  y
                     + GHC.srcSpanEndLine span
@@ -361,22 +367,27 @@ ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
               (g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->
                 (g, ExactPrint.DP (y - initialCommentSize, x))
               x -> x
-                pre' = map fixAbsoluteModuleDP pre
+            pre' = if shouldReformatPreamble
+              then map fixAbsoluteModuleDP pre
+              else pre
             mAnn' = mAnn { ExactPrint.annsDP = pre' }
-                filteredAnns'' = Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
+            filteredAnns'' =
-            in (filteredAnns'', post')
+              Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
-    in do
+          in
+            (filteredAnns'', post')
   traceIfDumpConf "bridoc annotations filtered/transformed"
                   _dconf_dump_annotations
     $ annsDoc filteredAnns'
 
-      config <- mAsk
+  if shouldReformatPreamble
-
+    then MultiRWSS.withoutMultiReader $ do
-      MultiRWSS.withoutMultiReader $ do
       MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil
       withTransformedAnns lmod $ do
         briDoc <- briDocMToPPM $ layoutModule lmod
         layoutBriDoc briDoc
+    else
+      let emptyModule = L loc m { hsmodDecls = [] }
+      in  MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule
   return post
 
 _sigHead :: Sig RdrName -> String

src/Language/Haskell/Brittany/Internal/Config.hs

@@ -64,6 +64,8 @@ staticDefaultConfig = Config
     , _lconfig_alignmentLimit            = coerce (30 :: Int)
     , _lconfig_alignmentBreakOnMultiline = coerce True
     , _lconfig_hangingTypeSignature      = coerce False
+    , _lconfig_reformatModulePreamble    = coerce True
+    , _lconfig_allowSingleLineExportList = coerce False
     }
   , _conf_errorHandling = ErrorHandlingConfig
     { _econf_produceOutputOnErrors   = coerce False
@@ -158,6 +160,8 @@ configParser = do
       , _lconfig_alignmentLimit            = mempty
       , _lconfig_alignmentBreakOnMultiline = mempty
       , _lconfig_hangingTypeSignature      = mempty
+      , _lconfig_reformatModulePreamble    = mempty
+      , _lconfig_allowSingleLineExportList = mempty
       }
     , _conf_errorHandling = ErrorHandlingConfig
       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors

src/Language/Haskell/Brittany/Internal/Config/Types.hs

@@ -84,6 +84,21 @@ data CLayoutConfig f = LayoutConfig
     --   -> SomeLongStuff
     -- As usual for hanging indentation, the result will be
     -- context-sensitive (in the function name).
+  , _lconfig_reformatModulePreamble :: f (Last Bool)
+    -- whether the module preamble/header (module keyword, name, export list,
+    -- import statements) are reformatted. If false, only the elements of the
+    -- module (everything past the "where") are reformatted.
+  , _lconfig_allowSingleLineExportList :: f (Last Bool)
+    -- if true, and it fits in a single line, and there are no comments in the
+    -- export list, the following layout will be used:
+    -- > module MyModule (abc, def) where
+    -- > [stuff]
+    -- otherwise, the multi-line version is used:
+    -- > module MyModule
+    -- >   ( abc
+    -- >   , def
+    -- >   )
+    -- > where
   }
   deriving (Generic)
 

src/Language/Haskell/Brittany/Internal/Layouters/Module.hs

@@ -29,13 +29,17 @@ layoutModule lmod@(L _ mod') = case mod' of
   HsModule Nothing  _   imports _ _ _ -> docLines $ map layoutImport imports
   HsModule (Just n) les imports _ _ _ -> do
     let tn = Text.pack $ moduleNameString $ unLoc n
+    allowSingleLineExportList <- mAsk
+      <&> _conf_layout
+      .>  _lconfig_allowSingleLineExportList
+      .>  confUnpack
     docLines
       $ docSeq
           [ docNodeAnnKW lmod Nothing docEmpty
              -- A pseudo node that serves merely to force documentation
              -- before the node
-          , docNodeMoveToKWDP lmod AnnModule $ docAlt
+          , docNodeMoveToKWDP lmod AnnModule $ docAltFilter
-            (  [ docForceSingleline $ docSeq
+            [ (,) allowSingleLineExportList $ docForceSingleline $ docSeq
                    [ appSep $ docLit $ Text.pack "module"
                    , appSep $ docLit tn
                    , docWrapNode lmod $ appSep $ case les of
@@ -43,8 +47,7 @@ layoutModule lmod@(L _ mod') = case mod' of
                      Just x  -> layoutLLIEs True x
                    , docLit $ Text.pack "where"
                    ]
-               ]
+            , (,) otherwise $ docLines
-            ++ [ docLines
                    [ docAddBaseY BrIndentRegular $ docPar
                      (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
                      )
@@ -55,6 +58,5 @@ layoutModule lmod@(L _ mod') = case mod' of
                    , docLit $ Text.pack "where"
                    ]
             ]
-            )
           ]
       : map layoutImport imports