brittany.cabal

@@ -67,6 +67,9 @@ library {
     Language.Haskell.Brittany.Internal.Layouters.Expr
     Language.Haskell.Brittany.Internal.Layouters.Stmt
     Language.Haskell.Brittany.Internal.Layouters.Pattern
+    Language.Haskell.Brittany.Internal.Layouters.IE
+    Language.Haskell.Brittany.Internal.Layouters.Import
+    Language.Haskell.Brittany.Internal.Layouters.Module
     Language.Haskell.Brittany.Internal.Transformations.Alt
     Language.Haskell.Brittany.Internal.Transformations.Floating
     Language.Haskell.Brittany.Internal.Transformations.Par

src-literatetests/10-tests.blt

@@ -558,3 +558,282 @@ func =
        ]
     ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
 
+
+###############################################################################
+###############################################################################
+###############################################################################
+#group module
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test simple
+module Main where
+
+#test no-exports
+module Main () where
+
+#test one-export
+module Main (main) where
+
+#test several-exports
+module Main (main, test1, test2) where
+
+#test many-exports
+module Main
+  ( main
+  , test1
+  , test2
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  , test8
+  , test9
+  )
+where
+
+#test exports-with-comments
+module Main
+  ( main
+  -- main
+  , test1
+  , test2
+  -- Test 3
+  , test3
+  , test4
+  -- Test 5
+  , test5
+  -- Test 6
+  )
+where
+
+#test simple-export-with-things
+module Main (Test(..)) where
+
+#test simple-export-with-module-contents
+module Main (module Main) where
+
+#test export-with-things
+module Main (Test(Test, a, b)) where
+
+#test export-with-empty-thing
+module Main (Test()) where
+
+#test empty-with-comment
+-- Intentionally left empty
+
+###############################################################################
+###############################################################################
+###############################################################################
+#group module.import
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test simple-import
+import           Data.List
+
+#test simple-import-alias
+import           Data.List                               as L
+
+#test simple-qualified-import
+import qualified Data.List
+
+#test simple-qualified-import-alias
+import qualified Data.List                               as L
+
+#test simple-safe
+import safe      Data.List                               as L
+
+#test simple-source
+import {-# SOURCE #-} Data.List                           ( )
+
+#test simple-safe-qualified
+import safe qualified Data.List
+
+#test simple-safe-qualified-source
+import {-# SOURCE #-} safe qualified Data.List
+
+#test simple-qualified-package
+import qualified "base" Data.List
+
+#test qualifier-effect
+import {-# SOURCE #-} safe qualified "base" Data.List    as L
+import {-# SOURCE #-} safe qualified "base" Data.List     ( )
+import {-# SOURCE #-} safe qualified Data.List     hiding ( )
+
+#test instances-only
+import qualified Data.List                                ( )
+
+#test one-element
+import           Data.List                                ( nub )
+
+#test several-elements
+import           Data.List                                ( nub
+                                                          , foldl'
+                                                          , indexElem
+                                                          )
+
+#test a-ridiculous-amount-of-elements
+import           Test                                     ( Long
+                                                          , list
+                                                          , with
+                                                          , items
+                                                          , that
+                                                          , will
+                                                          , not
+                                                          , quite
+                                                          , fit
+                                                          , onA
+                                                          , single
+                                                          , line
+                                                          , anymore
+                                                          )
+
+#test with-things
+import           Test                                     ( T
+                                                          , T2()
+                                                          , T3(..)
+                                                          , T4(T4)
+                                                          , T5(T5, t5)
+                                                          , T6((<|>))
+                                                          , (+)
+                                                          )
+
+#test hiding
+import           Test                              hiding ( )
+import           Test                                    as T
+                                                   hiding ( )
+
+#test long-module-name
+import           TestJustShortEnoughModuleNameLikeThisOne ( )
+import           TestJustAbitToLongModuleNameLikeThisOneIs
+                                                          ( )
+
+import           TestJustShortEnoughModuleNameLikeThisOn as T
+import           TestJustAbitToLongModuleNameLikeThisOneI
+                                                         as T
+
+import           TestJustShortEnoughModuleNameLike hiding ( )
+import           TestJustAbitToLongModuleNameLikeTh
+                                                   hiding ( )
+
+import           MoreThanSufficientlyLongModuleNameWithSome
+                                                          ( items
+                                                          , that
+                                                          , will
+                                                          , not
+                                                          , fit
+                                                          , inA
+                                                          , compact
+                                                          , layout
+                                                          )
+
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
+                                                          ( )
+
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T
+import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff
+                                                         as T
+import {-# SOURCE #-} safe qualified "qualifier" A hiding ( )
+import {-# SOURCE #-} safe qualified "qualifiers" A
+                                                   hiding ( )
+
+#test import-with-comments
+-- Test
+import           Data.List                                ( nub ) -- Test
+{- Test -}
+import qualified Data.List                               as L
+                                                          ( foldl' ) {- Test -}
+
+-- Test
+import           Test                                     ( test )
+
+#test import-with-comments-2
+
+import           Test                                     ( abc
+                                                          , def
+                                                          -- comment
+                                                          )
+
+#test import-with-comments-3
+
+import           Test                                     ( abc
+                                                          -- comment
+                                                          )
+
+#test import-with-comments-4
+import           Test                                     ( abc
+                                                          -- comment
+                                                          , def
+                                                          , ghi
+                                                          {- comment -}
+                                                          , jkl
+                                                          -- comment
+                                                          )
+
+#test import-with-comments-5
+import           Test                                     ( -- comment
+                                                          )
+
+#test long-bindings
+import           Test                                     ( longbindingNameThatoverflowsColum )
+import           Test                                     ( Long( List
+                                                                , Of
+                                                                , Things
+                                                                ) )
+
+#test things-with-with-comments
+import           Test                                     ( Thing( -- Comments
+                                                                 )
+                                                          )
+import           Test                                     ( Thing( Item
+                                                                 -- and Comment
+                                                                 )
+                                                          )
+import           Test                                     ( Thing( With
+                                                                 -- Comments
+                                                                 , and
+                                                                 -- also
+                                                                 , items
+                                                                 -- !
+                                                                 )
+                                                          )
+#test prefer-dense-empty-list
+import           VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
+                                                          ( )
+
+#test preamble full-preamble
+{-# LANGUAGE BangPatterns #-}
+
+{-
+ - Test module
+ -}
+module Test
+  ( test1
+  -- ^ test
+  , test2
+  -- | test
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  , test8
+  , test9
+  , test10
+  -- Test 10
+  )
+where
+
+-- Test
+import           Data.List                                ( nub ) -- Test
+{- Test -}
+import qualified Data.List                               as L
+                                                          ( foldl' ) {- Test -}
+
+-- Test
+import           Test                                     ( test )

src-literatetests/tests-context-free.blt

@@ -593,6 +593,256 @@ func =
       ]
     ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc]
 
+###############################################################################
+###############################################################################
+###############################################################################
+#group module
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test simple
+module Main where
+
+#test no-exports
+module Main () where
+
+#test one-export
+module Main (main) where
+
+#test several-exports
+module Main (main, test1, test2) where
+
+#test many-exports
+module Main
+  ( main
+  , test1
+  , test2
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  , test8
+  , test9
+  )
+where
+
+#test exports-with-comments
+module Main
+  ( main
+  -- main
+  , test1
+  , test2
+  -- Test 3
+  , test3
+  , test4
+  -- Test 5
+  , test5
+  -- Test 6
+  )
+where
+
+#test simple-export-with-things
+module Main (Test(..)) where
+
+#test simple-export-with-module-contents
+module Main (module Main) where
+
+#test export-with-things
+module Main (Test(Test, a, b)) where
+
+#test export-with-empty-thing
+module Main (Test()) where
+
+#test empty-with-comment
+-- Intentionally left empty
+
+###############################################################################
+###############################################################################
+###############################################################################
+#group import
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test simple-import
+import Data.List
+
+#test simple-import-alias
+import Data.List as L
+
+#test simple-qualified-import
+import qualified Data.List
+
+#test simple-qualified-import-alias
+import qualified Data.List as L
+
+#test simple-safe
+import safe Data.List as L
+
+#test simple-source
+import {-# SOURCE #-} Data.List ()
+
+#test simple-safe-qualified
+import safe qualified Data.List hiding (nub)
+
+#test simple-safe-qualified-source
+import {-# SOURCE #-} safe qualified Data.List
+
+#test simple-qualified-package
+import qualified "base" Data.List
+
+#test qualifier-effect
+import {-# SOURCE #-} safe qualified "base" Data.List as L
+import {-# SOURCE #-} safe qualified "base" Data.List ()
+import {-# SOURCE #-} safe qualified Data.List hiding ()
+
+#test instances-only
+import qualified Data.List ()
+
+#test one-element
+import Data.List (nub)
+
+#test several-elements
+import Data.List (nub, foldl', indexElem)
+
+#test a-ridiculous-amount-of-elements
+import Test
+  ( Long
+  , list
+  , with
+  , items
+  , that
+  , will
+  , not
+  , quite
+  , fit
+  , onA
+  , single
+  , line
+  , anymore
+  )
+
+#test with-things
+import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+))
+
+#test hiding
+import Test hiding ()
+import Test as T hiding ()
+
+#test long-module-name
+import TestJustShortEnoughModuleNameLikeThisOne ()
+import TestJustAbitToLongModuleNameLikeThisOneIs ()
+import TestJustShortEnoughModuleNameLikeThisOn as T
+import TestJustAbitToLongModuleNameLikeThisOneI as T
+import TestJustShortEnoughModuleNameLike hiding ()
+import TestJustAbitToLongModuleNameLikeTh hiding ()
+import MoreThanSufficientlyLongModuleNameWithSome
+  (items, that, will, not, fit, inA, compact, layout)
+
+#test import-with-comments
+-- Test
+import Data.List (nub) -- Test
+{- Test -}
+import qualified Data.List as L (foldl') {- Test -}
+
+#test import-with-comments-2
+
+import Test
+  ( abc
+  , def
+  -- comment
+  )
+
+#test import-with-comments-3
+
+import Test
+  ( abc
+  -- comment
+  )
+
+#test import-with-comments-4
+import Test
+  ( abc
+  -- comment
+  , def
+  , ghi
+  {- comment -}
+  , jkl
+  -- comment
+  )
+
+-- Test
+import Test (test)
+
+#test import-with-comments-5
+import Test
+  ( -- comment
+  )
+
+#test long-bindings
+import Test (longbindingNameThatoverflowsColum)
+import Test (Long(List, Of, Things))
+
+#test things-with-with-comments
+import Test
+  ( Thing( With
+         -- Comments
+         , and
+         -- also
+         , items
+         -- !
+         )
+  )
+import Test
+  ( Thing( Item
+         -- and Comment
+         )
+  )
+import Test
+  ( Thing( With
+         -- Comments
+         , and
+         -- also
+         , items
+         -- !
+         )
+  )
+
+#test prefer-dense-empty-list
+import VeryLongModuleNameThatCouldEvenCauseAnEmptyBindingListToExpandIntoMultipleLine
+  ()
+
+#test preamble full-preamble
+{-# LANGUAGE BangPatterns #-}
+
+{-
+ - Test module
+ -}
+module Test
+  ( test1
+  -- ^ test
+  , test2
+  -- | test
+  , test3
+  , test4
+  , test5
+  , test6
+  , test7
+  , test8
+  , test9
+  , test10
+  )
+where
+
+-- Test
+import Data.List (nub) -- Test
+{- Test -}
+import qualified Data.List as L (foldl') {- Test -}
+
+-- Test
+import Test (test)
 
 ###############################################################################
 ###############################################################################
@@ -1128,4 +1378,3 @@ foo =
 ##           ]
 ##  where
 ##   role = stringProperty "WM_WINDOW_ROLE"
-

src/Language/Haskell/Brittany/Internal.hs

@@ -33,6 +33,7 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics
 
 import           Language.Haskell.Brittany.Internal.Layouters.Type
 import           Language.Haskell.Brittany.Internal.Layouters.Decl
+import           Language.Haskell.Brittany.Internal.Layouters.Module
 import           Language.Haskell.Brittany.Internal.Utils
 import           Language.Haskell.Brittany.Internal.Backend
 import           Language.Haskell.Brittany.Internal.BackendUtils
@@ -160,7 +161,7 @@ pPrintModule conf anns parsedModule =
   in
     tracer $ (errs, Text.Builder.toLazyText out)
   -- unless () $ do
-  --   
+  --
   --   debugStrings `forM_` \s ->
   --     trace s $ return ()
 
@@ -248,30 +249,8 @@ parsePrintModuleTests conf filename input = do
 --         else return $ TextL.toStrict $ Text.Builder.toLazyText out
 
 ppModule :: GenLocated SrcSpan (HsModule RdrName) -> PPM ()
-ppModule lmod@(L loc m@(HsModule _name _exports _imports decls _ _)) = do
-  let emptyModule = L loc m { hsmodDecls = [] }
-  (anns', post) <- do
-    anns <- mAsk
-    -- evil partiality. but rather unlikely.
-    return $ case Map.lookup (ExactPrint.Types.mkAnnKey lmod) anns of
-      Nothing -> (anns, [])
-      Just mAnn ->
-        let modAnnsDp = ExactPrint.Types.annsDP mAnn
-            isWhere (ExactPrint.Types.G AnnWhere) = True
-            isWhere _                             = False
-            isEof (ExactPrint.Types.G AnnEofPos) = True
-            isEof _                              = False
-            whereInd    = List.findIndex (isWhere . fst) modAnnsDp
-            eofInd      = List.findIndex (isEof . fst) modAnnsDp
-            (pre, post) = case (whereInd, eofInd) of
-              (Nothing, Nothing) -> ([], modAnnsDp)
-              (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 }
-            anns'       = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' anns
-        in  (anns', post)
-  MultiRWSS.withMultiReader anns' $ processDefault emptyModule
+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
@@ -341,6 +320,51 @@ ppDecl d@(L loc decl) = case decl of
     layoutBriDoc briDoc
   _ -> briDocMToPPM (briDocByExactNoComment d) >>= layoutBriDoc
 
+-- Prints the information associated with the module annotation
+-- This includes the imports
+ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
+           -> PPM [(ExactPrint.Types.KeywordId, ExactPrint.Types.DeltaPos)]
+ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
+  filteredAnns <- mAsk <&> \annMap ->
+    Map.findWithDefault Map.empty (ExactPrint.Types.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
+          Nothing -> (filteredAnns, [])
+          Just mAnn ->
+            let modAnnsDp = ExactPrint.Types.annsDP mAnn
+                isWhere (ExactPrint.Types.G AnnWhere) = True
+                isWhere _                             = False
+                isEof (ExactPrint.Types.G AnnEofPos) = True
+                isEof _                              = False
+                whereInd    = List.findIndex (isWhere . fst) modAnnsDp
+                eofInd      = List.findIndex (isEof . fst) modAnnsDp
+                (pre, post') = case (whereInd, eofInd) of
+                  (Nothing, Nothing) -> ([], modAnnsDp)
+                  (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 }
+                filteredAnns'' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' filteredAnns
+            in (filteredAnns'', post')
+    in do
+      traceIfDumpConf "bridoc annotations filtered/transformed"
+                      _dconf_dump_annotations
+        $ annsDoc filteredAnns'
+
+      config <- mAsk
+
+      MultiRWSS.withoutMultiReader $ do
+        MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil
+        withTransformedAnns lmod $ do
+          briDoc <- briDocMToPPM $ layoutModule lmod
+          layoutBriDoc briDoc
+      return post
+
 _sigHead :: Sig RdrName -> String
 _sigHead = \case
   TypeSig names _ ->

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

@@ -42,6 +42,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
   , appSep
   , docCommaSep
   , docParenLSep
+  , docParenR
   , docTick
   , spacifyDocs
   , briDocMToPPM
@@ -465,6 +466,9 @@ docCommaSep = appSep $ docLit $ Text.pack ","
 docParenLSep :: ToBriDocM BriDocNumbered
 docParenLSep = appSep $ docLit $ Text.pack "("
 
+docParenR :: ToBriDocM BriDocNumbered
+docParenR = docLit $ Text.pack ")"
+
 docTick :: ToBriDocM BriDocNumbered
 docTick = docLit $ Text.pack "'"
 

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

@@ -0,0 +1,133 @@
+module Language.Haskell.Brittany.Internal.Layouters.IE
+  ( layoutIE
+  , layoutLLIEs
+  , layoutAnnAndSepLLIEs
+  )
+where
+
+#include "prelude.inc"
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           RdrName (RdrName(..))
+import           GHC     ( unLoc
+                         , runGhc
+                         , GenLocated(L)
+                         , moduleNameString
+                         , AnnKeywordId(..)
+                         , Located
+                         )
+import           HsSyn
+import           Name
+import           HsImpExp
+import           FieldLabel
+import qualified FastString
+import           BasicTypes
+
+import           Language.Haskell.Brittany.Internal.Utils
+
+
+
+#if MIN_VERSION_ghc(8,2,0)
+prepareName :: LIEWrappedName name -> Located name
+prepareName = ieLWrappedName
+#else
+prepareName :: Located name -> Located name
+prepareName = id
+#endif
+
+layoutIE :: ToBriDoc IE
+layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
+  IEVar      _                     -> ien
+  IEThingAbs _                     -> ien
+  IEThingAll _                     -> docSeq [ien, docLit $ Text.pack "(..)"]
+  IEThingWith _ (IEWildcard _) _ _ -> docSeq [ien, docLit $ Text.pack "(..)"]
+  IEThingWith _ _ ns _ -> do
+    hasComments <- hasAnyCommentsBelow lie
+    docAltFilter
+      [(not hasComments, docSeq $  [ien, docLit $ Text.pack "("]
+        ++ intersperse docCommaSep (map nameDoc ns)
+        ++ [docParenR])
+      ,(otherwise, docSeq [ien, layoutItems (splitFirstLast ns)])
+      ]
+   where
+    nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
+    layoutItem n = docSeq [docCommaSep, docWrapNode n $ nameDoc n]
+    layoutItems FirstLastEmpty =
+      docSetBaseY $
+        docLines [docSeq [docParenLSep, docWrapNodeRest lie docEmpty]
+                 ,docParenR
+                 ]
+    layoutItems (FirstLastSingleton n) =
+      docSetBaseY $ docLines
+        [docSeq [docParenLSep, docWrapNodeRest lie $ nameDoc n], docParenR]
+    layoutItems (FirstLast n1 nMs nN)  =
+      docSetBaseY $ docLines $
+         [docSeq [docParenLSep, docWrapNode n1 $ nameDoc n1]]
+         ++ map layoutItem nMs
+         ++ [ docSeq [docCommaSep, docWrapNodeRest lie $ nameDoc nN]
+            , docParenR
+            ]
+  IEModuleContents n -> docSeq
+    [ docLit $ Text.pack "module"
+    , docSeparator
+    , docLit . Text.pack . moduleNameString $ unLoc n
+    ]
+  _ -> docEmpty
+  where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie)
+
+-- Helper function to deal with Located lists of LIEs.
+-- In particular this will also associate documentation
+-- from the located list that actually belongs to the last IE.
+-- It also adds docCommaSep to all but the first element
+-- This configuration allows both vertical and horizontal
+-- handling of the resulting list. Adding parens is
+-- left to the caller since that is context sensitive
+layoutAnnAndSepLLIEs
+  :: Located [LIE RdrName] -> ToBriDocM [ToBriDocM BriDocNumbered]
+layoutAnnAndSepLLIEs llies@(L _ lies) = do
+  let makeIENode ie = docSeq [docCommaSep, ie]
+  let ieDocs = layoutIE <$> lies
+  ieCommaDocs <-
+    docWrapNodeRest llies $ sequence $ case splitFirstLast ieDocs of
+      FirstLastEmpty        -> []
+      FirstLastSingleton ie -> [ie]
+      FirstLast ie1 ieMs ieN ->
+        [ie1] ++ map makeIENode ieMs ++ [makeIENode ieN]
+  pure $ fmap pure ieCommaDocs -- returned shared nodes
+
+-- Builds a complete layout for the given located
+-- list of LIEs. The layout provides two alternatives:
+-- (item, item, ..., item)
+-- ( item
+-- , item
+-- ...
+-- , item
+-- )
+-- If the llies contains comments the list will
+-- always expand over multiple lines, even when empty:
+-- () -- no comments
+-- ( -- a comment
+-- )
+layoutLLIEs :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
+layoutLLIEs llies = do
+  ieDs <- layoutAnnAndSepLLIEs llies
+  hasComments <- hasAnyCommentsBelow llies
+  case ieDs of
+    [] -> docAltFilter
+            [ (not hasComments, docLit $ Text.pack "()")
+            , ( hasComments
+              , docPar
+                  (docSeq [docParenLSep, docWrapNodeRest llies docEmpty])
+                  docParenR
+              )
+            ]
+    (ieDsH:ieDsT) ->
+      docAltFilter
+        [ (not hasComments, docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR])
+        , (otherwise, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) $
+            docLines $ ieDsT
+            ++ [docParenR])
+        ]

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

@@ -0,0 +1,134 @@
+module Language.Haskell.Brittany.Internal.Layouters.Import (layoutImport) where
+
+#include "prelude.inc"
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Layouters.IE
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           RdrName                                  ( RdrName(..) )
+import           GHC                                      ( unLoc
+                                                          , GenLocated(L)
+                                                          , moduleNameString
+                                                          , Located
+                                                          )
+import           HsSyn
+import           Name
+import           FieldLabel
+import qualified FastString
+import           BasicTypes
+
+import           Language.Haskell.Brittany.Internal.Utils
+
+
+
+#if MIN_VERSION_ghc(8,2,0)
+prepPkg :: SourceText -> String
+prepPkg rawN = case rawN of
+  SourceText n -> n
+  -- This would be odd to encounter and the
+  -- result will most certainly be wrong
+  NoSourceText -> ""
+#else
+prepPkg :: String -> String
+prepPkg = id
+#endif
+#if MIN_VERSION_ghc(8,2,0)
+prepModName :: Located e -> e
+prepModName = unLoc
+#else
+prepModName :: e -> e
+prepModName = id
+#endif
+
+layoutImport :: ToBriDoc ImportDecl
+layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
+  ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do
+    importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
+    indentPolicy <- mAsk <&>  _conf_layout .> _lconfig_indentPolicy .> confUnpack
+    let
+      compact  = indentPolicy == IndentPolicyLeft
+      modNameT = Text.pack $ moduleNameString modName
+      pkgNameT = Text.pack . prepPkg . sl_st <$> pkg
+      masT     = Text.pack . moduleNameString . prepModName <$> mas
+      hiding   = maybe False fst mllies
+      minQLength = length "import qualified "
+      qLengthReal =
+        let qualifiedPart = if q then length "qualified " else 0
+            safePart      = if safe then length "safe " else 0
+            pkgPart       = maybe 0 ((+ 1) . Text.length) pkgNameT
+            srcPart       = if src then length "{-# SOURCE #-} " else 0
+        in  length "import " + srcPart + safePart + qualifiedPart + pkgPart
+      qLength          = max minQLength qLengthReal
+      -- Cost in columns of importColumn
+      asCost           = length "as "
+      bindingCost      = if hiding then length "hiding ( " else length "( "
+      nameCost         = Text.length modNameT + qLength
+      importQualifiers = docSeq
+        [ appSep $ docLit $ Text.pack "import"
+        , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
+        , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
+        , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
+        , maybe docEmpty (appSep . docLit) pkgNameT
+        ]
+      indentName =
+        if compact then id else docEnsureIndent (BrIndentSpecial qLength)
+      modNameD =
+        indentName $ appSep $ docLit modNameT
+      hidDoc =
+        if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
+      importHead = docSeq [importQualifiers, modNameD]
+      bindingsD  = case mllies of
+        Nothing -> docEmpty
+        Just (_, llies) -> do
+          hasComments <- hasAnyCommentsBelow llies
+          if compact
+          then docSeq [hidDoc, layoutLLIEs llies]
+          else do
+            ieDs <- layoutAnnAndSepLLIEs llies
+            docWrapNodeRest llies $ case ieDs of
+              -- ..[hiding].( )
+              [] -> if hasComments
+                then docPar
+                  (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
+                  docParenR
+                else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
+                -- ..[hiding].( b )
+              [ieD] -> if hasComments
+                then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR
+                else docSeq [hidDoc, docParenLSep, ieD, docSeparator, docParenR]
+                -- ..[hiding].( b
+                --            , b'
+                --            )
+              (ieD:ieDs') ->
+                docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])
+                  $  docLines
+                  $  ieDs'
+                  ++ [docParenR]
+      bindingLine =
+        docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD
+      makeAsDoc asT =
+        docSeq [appSep $ docLit $ Text.pack "as", appSep $ docLit asT]
+    if compact
+    then
+      let asDoc = maybe docEmpty makeAsDoc masT
+      in docAlt
+        [ docForceSingleline $
+            docSeq [importHead, asDoc, docSetBaseY $ bindingsD]
+        , docAddBaseY BrIndentRegular $
+            docPar (docSeq [importHead, asDoc]) bindingsD
+        ]
+    else
+      case masT of
+        Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine]
+               | otherwise  -> docLines [importHead, asDoc, bindingLine]
+         where
+          enoughRoom = nameCost < importCol - asCost
+          asDoc =
+            docEnsureIndent (BrIndentSpecial (importCol - asCost))
+              $ makeAsDoc n
+        Nothing | enoughRoom -> docSeq [importHead, bindingLine]
+                | otherwise  -> docLines [importHead, bindingLine]
+          where enoughRoom = nameCost < importCol - bindingCost
+  _ -> docEmpty

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

@@ -0,0 +1,58 @@
+module Language.Haskell.Brittany.Internal.Layouters.Module (layoutModule) where
+
+#include "prelude.inc"
+
+import           Language.Haskell.Brittany.Internal.Types
+import           Language.Haskell.Brittany.Internal.LayouterBasics
+import           Language.Haskell.Brittany.Internal.Layouters.IE
+import           Language.Haskell.Brittany.Internal.Layouters.Import
+import           Language.Haskell.Brittany.Internal.Config.Types
+
+import           RdrName (RdrName(..))
+import GHC (unLoc, runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..))
+import           HsSyn
+import           Name
+import           HsImpExp
+import           FieldLabel
+import qualified FastString
+import           BasicTypes
+import           Language.Haskell.GHC.ExactPrint as ExactPrint
+import           Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
+
+import           Language.Haskell.Brittany.Internal.Utils
+
+
+
+layoutModule :: ToBriDoc HsModule
+layoutModule lmod@(L _ mod') =
+  case mod' of
+    -- Implicit module Main
+    HsModule Nothing  _   imports _ _ _ -> docLines $ map layoutImport imports
+    HsModule (Just n) les imports _ _ _ -> do
+      let tn         = Text.pack $ moduleNameString $ unLoc n
+          exportsDoc = maybe docEmpty layoutLLIEs les
+      docLines
+        $ docSeq
+            [ docWrapNode lmod docEmpty
+               -- A pseudo node that serves merely to force documentation
+               -- before the node
+            , docAlt
+              (  [ docForceSingleline $ docSeq
+                     [ appSep $ docLit $ Text.pack "module"
+                     , appSep $ docLit tn
+                     , appSep exportsDoc
+                     , docLit $ Text.pack "where"
+                     ]
+                 ]
+              ++ [ docLines
+                     [ docAddBaseY BrIndentRegular $ docPar
+                       ( docSeq
+                         [appSep $ docLit $ Text.pack "module", docLit tn]
+                       )
+                       (docForceMultiline exportsDoc)
+                     , docLit $ Text.pack "where"
+                     ]
+                 ]
+              )
+            ]
+        : map layoutImport imports

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

@@ -178,6 +178,7 @@ data ColSig
   | ColTuple
   | ColTuples
   | ColOpPrefix -- merge with ColList ? other stuff?
+  | ColImport
 
   -- TODO
   deriving (Eq, Ord, Data.Data.Data, Show)