Improve module layouting in two aspects

- IEThingWith in export list can now be single-line
- Now respect offset of the "module" keyword
  (retain empty lines after pragmas, for example)

src-literatetests/10-tests.blt

@@ -625,6 +625,15 @@ module Main (module Main) where
 #test export-with-things
 module Main (Test(Test, a, b)) where
 
+#test export-with-things-comment
+-- comment1
+
+module Main
+  ( Test(Test, a, b)
+  , foo -- comment2
+  ) -- comment3
+where
+
 #test export-with-empty-thing
 module Main (Test()) where
 

src/Language/Haskell/Brittany/Internal.hs

@@ -16,7 +16,7 @@ where
 #include "prelude.inc"
 
 import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
 import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
 
 import           Data.Data
@@ -133,7 +133,7 @@ parsePrintModule configRaw inputText = runExceptT $ do
 -- can occur.
 pPrintModule
   :: Config
-  -> ExactPrint.Types.Anns
+  -> ExactPrint.Anns
   -> GHC.ParsedSource
   -> ([BrittanyError], TextL.Text)
 pPrintModule conf anns parsedModule =
@@ -169,7 +169,7 @@ pPrintModule conf anns parsedModule =
 -- if it does not.
 pPrintModuleAndCheck
   :: Config
-  -> ExactPrint.Types.Anns
+  -> ExactPrint.Anns
   -> GHC.ParsedSource
   -> IO ([BrittanyError], TextL.Text)
 pPrintModuleAndCheck conf anns parsedModule = do
@@ -253,7 +253,7 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
   post <- ppPreamble lmod
   decls `forM_` \decl -> do
     filteredAnns <- mAsk <&> \annMap ->
-      Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey decl) annMap
+      Map.findWithDefault Map.empty (ExactPrint.mkAnnKey decl) annMap
 
     traceIfDumpConf "bridoc annotations filtered/transformed"
                     _dconf_dump_annotations
@@ -266,26 +266,26 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
       ppDecl decl
   let finalComments = filter
         ( fst .> \case
-          ExactPrint.Types.AnnComment{} -> True
+          ExactPrint.AnnComment{} -> True
           _                             -> False
         )
         post
   post `forM_` \case
-    (ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do
+    (ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
       ppmMoveToExactLoc l
       mTell $ Text.Builder.fromString cmStr
-    (ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->
+    (ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
       let
-        folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of
+        folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
-          ExactPrint.Types.AnnComment cm
+          ExactPrint.AnnComment cm
-            | GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm
+            | GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm
-            -> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
+            -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
-               , y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
+               , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
                )
-          _ -> (acc + x, y)
+          _ -> (acc + y, x)
-        (cmX, cmY) = foldl' folder (0, 0) finalComments
+        (cmY, cmX) = foldl' folder (0, 0) finalComments
       in
-        ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)
+        ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)
     _ -> return ()
 
 withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()
@@ -323,23 +323,23 @@ ppDecl d@(L loc decl) = case decl of
 -- Prints the information associated with the module annotation
 -- This includes the imports
 ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
-           -> PPM [(ExactPrint.Types.KeywordId, ExactPrint.Types.DeltaPos)]
+           -> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
 ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
   filteredAnns <- mAsk <&> \annMap ->
-    Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey lmod) annMap
+    Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
     -- Since ghc-exactprint adds annotations following (implicit)
     -- modules to both HsModule and the elements in the module
     -- this can cause duplication of comments. So strip
     -- attached annotations that come after the module's where
     -- from the module node
   let (filteredAnns', post) =
-        case (ExactPrint.Types.mkAnnKey lmod) `Map.lookup` filteredAnns of
+        case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of
           Nothing -> (filteredAnns, [])
           Just mAnn ->
-            let modAnnsDp = ExactPrint.Types.annsDP mAnn
+            let modAnnsDp = ExactPrint.annsDP mAnn
-                isWhere (ExactPrint.Types.G AnnWhere) = True
+                isWhere (ExactPrint.G AnnWhere) = True
                 isWhere _                             = False
-                isEof (ExactPrint.Types.G AnnEofPos) = True
+                isEof (ExactPrint.G AnnEofPos) = True
                 isEof _                              = False
                 whereInd    = List.findIndex (isWhere . fst) modAnnsDp
                 eofInd      = List.findIndex (isEof . fst) modAnnsDp
@@ -348,8 +348,22 @@ ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
                   (Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
                   (Nothing, Just _i) -> ([], modAnnsDp)
                   (Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
-                mAnn'       = mAnn { ExactPrint.Types.annsDP = pre }
+                findInitialCommentSize = \case
-                filteredAnns'' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' filteredAnns
+                  ((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)):rest) ->
+                    let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm
+                    in   y
+                       + GHC.srcSpanEndLine span
+                       - GHC.srcSpanStartLine span
+                       + findInitialCommentSize rest
+                  _ -> 0
+                initialCommentSize = findInitialCommentSize pre
+                fixAbsoluteModuleDP = \case
+                  (g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->
+                    (g, ExactPrint.DP (y - initialCommentSize, x))
+                  x -> x
+                pre' = map fixAbsoluteModuleDP pre
+                mAnn'       = mAnn { ExactPrint.annsDP = pre' }
+                filteredAnns'' = Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
             in (filteredAnns'', post')
     in do
       traceIfDumpConf "bridoc annotations filtered/transformed"
@@ -415,7 +429,7 @@ layoutBriDoc briDoc = do
     -- simpl <- mGet <&> transformToSimple
     -- return simpl
 
-  anns :: ExactPrint.Types.Anns <- mAsk
+  anns :: ExactPrint.Anns <- mAsk
 
   let state = LayoutState
         { _lstate_baseYs           = [0]

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

@@ -250,6 +250,23 @@ layoutBriDocM = \case
             -- layoutMoveToIndentCol y
             layoutWriteAppendMultiline $ Text.pack $ comment
       -- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
+  BDMoveToKWDP annKey keyword bd -> do
+    mDP <- do
+      state <- mGet
+      let m    = _lstate_comments state
+      let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
+      let relevant = [ dp
+                     | Just ann <- [mAnn]
+                     , (ExactPrint.Types.G kw1, dp) <- ann
+                     , keyword == kw1
+                     ]
+      pure $ case relevant of
+        [] -> Nothing
+        (dp:_) -> Just dp
+    case mDP of
+      Nothing                           -> pure ()
+      Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y x
+    layoutBriDocM bd
   BDNonBottomSpacing bd -> layoutBriDocM bd
   BDSetParSpacing    bd -> layoutBriDocM bd
   BDForceParSpacing  bd -> layoutBriDocM bd
@@ -282,6 +299,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
     BDAnnotationPrior _ bd  -> rec bd
     BDAnnotationKW _ _ bd   -> rec bd
     BDAnnotationRest _ bd   -> rec bd
+    BDMoveToKWDP _ _ bd     -> rec bd
     BDLines ls@(_:_)        -> do
       x <- StateS.get
       return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
@@ -317,6 +335,7 @@ briDocIsMultiLine briDoc = rec briDoc
     BDAnnotationPrior _ bd  -> rec bd
     BDAnnotationKW _ _ bd   -> rec bd
     BDAnnotationRest _ bd   -> rec bd
+    BDMoveToKWDP _ _ bd     -> rec bd
     BDLines (_:_:_)         -> True
     BDLines [_    ]         -> False
     BDLines []              -> error "briDocIsMultiLine BDLines []"

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

@@ -16,6 +16,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docSeq
   , docPar
   , docNodeAnnKW
+  , docNodeMoveToKWDP
   , docWrapNode
   , docWrapNodePrior
   , docWrapNodeRest
@@ -29,6 +30,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , docAnnotationPrior
   , docAnnotationKW
   , docAnnotationRest
+  , docMoveToKWDP
   , docNonBottomSpacing
   , docSetParSpacing
   , docForceParSpacing
@@ -441,6 +443,13 @@ docAnnotationKW
   -> ToBriDocM BriDocNumbered
 docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm
 
+docMoveToKWDP
+  :: AnnKey
+  -> AnnKeywordId
+  -> ToBriDocM BriDocNumbered
+  -> ToBriDocM BriDocNumbered
+docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm
+
 docAnnotationRest
   :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
 docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm
@@ -481,6 +490,15 @@ docNodeAnnKW
 docNodeAnnKW ast kw bdm =
   docAnnotationKW (ExactPrint.Types.mkAnnKey ast) kw bdm
 
+docNodeMoveToKWDP
+  :: Data.Data.Data ast
+  => Located ast
+  -> AnnKeywordId
+  -> ToBriDocM BriDocNumbered
+  -> ToBriDocM BriDocNumbered
+docNodeMoveToKWDP ast kw bdm =
+  docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm
+
 class DocWrapable a where
   docWrapNode :: ( Data.Data.Data ast)
               => Located ast

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

@@ -117,8 +117,8 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do
 -- () -- no comments
 -- ( -- a comment
 -- )
-layoutLLIEs :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
+layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
-layoutLLIEs llies = do
+layoutLLIEs enableSingleline llies = do
   ieDs        <- layoutAnnAndSepLLIEs llies
   hasComments <- hasAnyCommentsBelow llies
   case ieDs of
@@ -130,7 +130,7 @@ layoutLLIEs llies = do
         )
       ]
     (ieDsH:ieDsT) -> docAltFilter
-      [ ( not hasComments
+      [ ( not hasComments && enableSingleline
         , docSeq
         $  [docLit (Text.pack "(")]
         ++ (docForceSingleline <$> ieDs)

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

@@ -84,7 +84,7 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
         Just (_, llies) -> do
           hasComments <- hasAnyCommentsBelow llies
           if compact
-          then docSeq [hidDoc, layoutLLIEs llies]
+          then docSeq [hidDoc, layoutLLIEs True llies]
           else do
             ieDs <- layoutAnnAndSepLLIEs llies
             docWrapNodeRest llies $ case ieDs of

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

@@ -24,35 +24,37 @@ import           Language.Haskell.Brittany.Internal.Utils
 
 
 layoutModule :: ToBriDoc HsModule
-layoutModule lmod@(L _ mod') =
+layoutModule lmod@(L _ mod') = case mod' of
-  case mod' of
     -- Implicit module Main
-    HsModule Nothing  _   imports _ _ _ -> docLines $ map layoutImport imports
+  HsModule Nothing  _   imports _ _ _ -> docLines $ map layoutImport imports
-    HsModule (Just n) les imports _ _ _ -> do
+  HsModule (Just n) les imports _ _ _ -> do
-      let tn         = Text.pack $ moduleNameString $ unLoc n
+    let tn = Text.pack $ moduleNameString $ unLoc n
-          exportsDoc = maybe docEmpty layoutLLIEs les
+    docLines
-      docLines
+      $ docSeq
-        $ docSeq
+          [ docNodeAnnKW lmod Nothing docEmpty
-            [ docWrapNode lmod docEmpty
+             -- A pseudo node that serves merely to force documentation
-               -- A pseudo node that serves merely to force documentation
+             -- before the node
-               -- before the node
+          , docNodeMoveToKWDP lmod AnnModule $ docAlt
-            , docAlt
+            (  [ docForceSingleline $ docSeq
-              (  [ docForceSingleline $ docSeq
+                   [ appSep $ docLit $ Text.pack "module"
-                     [ appSep $ docLit $ Text.pack "module"
+                   , appSep $ docLit tn
-                     , appSep $ docLit tn
+                   , docWrapNode lmod $ appSep $ case les of
-                     , appSep exportsDoc
+                     Nothing -> docEmpty
-                     , docLit $ Text.pack "where"
+                     Just x  -> layoutLLIEs True x
-                     ]
+                   , docLit $ Text.pack "where"
-                 ]
+                   ]
-              ++ [ docLines
+               ]
-                     [ docAddBaseY BrIndentRegular $ docPar
+            ++ [ docLines
-                       ( docSeq
+                   [ docAddBaseY BrIndentRegular $ docPar
-                         [appSep $ docLit $ Text.pack "module", docLit tn]
+                     (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]
-                       )
+                     )
-                       (docForceMultiline exportsDoc)
+                     (docWrapNode lmod $ case les of
-                     , docLit $ Text.pack "where"
+                       Nothing -> docEmpty
-                     ]
+                       Just x  -> layoutLLIEs False x
-                 ]
+                     )
-              )
+                   , docLit $ Text.pack "where"
-            ]
+                   ]
-        : map layoutImport imports
+               ]
+            )
+          ]
+      : map layoutImport imports

src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs

@@ -301,6 +301,8 @@ transformAlts briDoc =
           reWrap . BDFAnnotationRest annKey <$> rec bd
         BDFAnnotationKW annKey kw bd ->
           reWrap . BDFAnnotationKW annKey kw <$> rec bd
+        BDFMoveToKWDP annKey kw bd ->
+          reWrap . BDFMoveToKWDP annKey kw <$> rec bd
         BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
         BDFLines (l:lr) -> do
           ind <- _acp_indent <$> mGet
@@ -460,6 +462,7 @@ getSpacing !bridoc = rec bridoc
       BDFAnnotationPrior _annKey bd -> rec bd
       BDFAnnotationKW _annKey _kw bd -> rec bd
       BDFAnnotationRest  _annKey bd -> rec bd
+      BDFMoveToKWDP _annKey _kw bd -> rec bd
       BDFLines [] -> return
         $ LineModeValid
         $ VerticalSpacing 0 VerticalSpacingParNone False
@@ -705,6 +708,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
         BDFAnnotationPrior _annKey bd -> rec bd
         BDFAnnotationKW _annKey _kw bd -> rec bd
         BDFAnnotationRest  _annKey bd -> rec bd
+        BDFMoveToKWDP _annKey _kw bd -> rec bd
         BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
         BDFLines ls@(_:_) -> do
           -- we simply assume that lines is only used "properly", i.e. in

src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs

@@ -128,6 +128,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
   BDAnnotationPrior{} -> Nothing
   BDAnnotationKW{}    -> Nothing
   BDAnnotationRest{}  -> Nothing
+  BDMoveToKWDP{}      -> Nothing
   BDEnsureIndent{}    -> Nothing
   BDSetParSpacing{}   -> Nothing
   BDForceParSpacing{} -> Nothing

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

@@ -233,6 +233,7 @@ data BriDoc
   | BDAnnotationPrior AnnKey BriDoc
   | BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc
   | BDAnnotationRest  AnnKey BriDoc
+  | BDMoveToKWDP AnnKey AnnKeywordId BriDoc
   | BDLines [BriDoc]
   | BDEnsureIndent BrIndent BriDoc
   -- the following constructors are only relevant for the alt transformation
@@ -278,6 +279,7 @@ data BriDocF f
   | BDFAnnotationPrior AnnKey (f (BriDocF f))
   | BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))
   | BDFAnnotationRest  AnnKey (f (BriDocF f))
+  | BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))
   | BDFLines [(f (BriDocF f))]
   | BDFEnsureIndent BrIndent (f (BriDocF f))
   | BDFForceMultiline (f (BriDocF f))
@@ -311,6 +313,7 @@ instance Uniplate.Uniplate BriDoc where
   uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
   uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
   uniplate (BDAnnotationRest annKey bd)  = plate BDAnnotationRest |- annKey |* bd
+  uniplate (BDMoveToKWDP annKey kw bd)   = plate BDMoveToKWDP |- annKey |- kw |* bd
   uniplate (BDLines lines)               = plate BDLines ||* lines
   uniplate (BDEnsureIndent ind bd)       = plate BDEnsureIndent |- ind |* bd
   uniplate (BDForceMultiline   bd)       = plate BDForceMultiline |* bd
@@ -342,6 +345,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
   BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd
   BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd
   BDFAnnotationRest annKey bd  -> BDAnnotationRest annKey $ rec bd
+  BDFMoveToKWDP annKey kw bd   -> BDMoveToKWDP annKey kw $ rec bd
   BDFLines lines               -> BDLines $ rec <$> lines
   BDFEnsureIndent ind bd       -> BDEnsureIndent ind $ rec bd
   BDFForceMultiline   bd       -> BDForceMultiline $ rec bd
@@ -377,6 +381,7 @@ briDocSeqSpine = \case
   BDAnnotationPrior _annKey bd  -> briDocSeqSpine bd
   BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
   BDAnnotationRest _annKey bd   -> briDocSeqSpine bd
+  BDMoveToKWDP _annKey _kw bd   -> briDocSeqSpine bd
   BDLines lines                 -> foldl' (\(!()) -> briDocSeqSpine) () lines
   BDEnsureIndent _ind bd        -> briDocSeqSpine bd
   BDForceMultiline   bd         -> briDocSeqSpine bd