Generalise break_only_where to allow single-line module headers (#349)

Previously, the `break_only_where` option of `module_header` allowed choosing
between the following two styles:

1. `break_only_where: false`:

   ```haskell
   module Foo where

   module Bar
       ( main
       ) where
   ```

2. `break_only_where: true`:

   ```haskell
   module Foo
       where

   module Bar
       ( main
       ) where
   ```

In case a module only has a single export (e.g., `main` or `tests`) or no
exports at all (e.g., a module defining orphans), we still "break" the `where`:

```haskell
module Bar
    ( main
    ) where
module Orphans
    (
    ) where
```

It should be possible to print these module headers as:

```haskell
module Bar (main) where
module Orphans () where
```

We generalise the `break_only_where` option to `break_where` with the following
three possible values:

- `exports`: only break when there is an explicit export list.
- `single`: only break when the export list counts more than one export.
- `inline`: only break when the export list is too long. This is determined by
   the `columns` setting. Not applicable when the export list contains comments
   as newlines will be required.
- `always`: always break before the `where`.

Author: mrBliss

data/stylish-haskell.yaml

@@ -31,8 +31,15 @@ steps:
   #     # See `separate_lists` for the `imports` step.
   #     separate_lists: true
   #
-  #     # Whether to break the "where" if there are no exports.
-  #     break_only_where: false
+  #     # When to break the "where".
+  #     # Possible values:
+  #     # - exports: only break when there is an explicit export list.
+  #     # - single: only break when the export list counts more than one export.
+  #     # - inline: only break when the export list is too long. This is
+  #     #   determined by the `columns` setting. Not applicable when the export
+  #     #   list contains comments as newlines will be required.
+  #     # - always: always break before the "where".
+  #     break_where: exports
 
   # Format record definitions. This is disabled by default.
   #

lib/Language/Haskell/Stylish/Config.hs

@@ -196,14 +196,23 @@ parseEnum strs _   (Just k) = case lookup k strs of
 
 --------------------------------------------------------------------------------
 parseModuleHeader :: Config -> A.Object -> A.Parser Step
-parseModuleHeader _ o = fmap ModuleHeader.step $ ModuleHeader.Config
-    <$> o A..:? "indent"           A..!= ModuleHeader.indent         def
-    <*> o A..:? "sort"             A..!= ModuleHeader.sort           def
-    <*> o A..:? "separate_lists"   A..!= ModuleHeader.separateLists  def
-    <*> o A..:? "break_only_where" A..!= ModuleHeader.breakOnlyWhere def
+parseModuleHeader config o = fmap (ModuleHeader.step columns) $ ModuleHeader.Config
+    <$> (o A..:? "indent"         A..!= ModuleHeader.indent        def)
+    <*> (o A..:? "sort"           A..!= ModuleHeader.sort          def)
+    <*> (o A..:? "separate_lists" A..!= ModuleHeader.separateLists def)
+    <*> (o A..:? "break_where"      >>= parseEnum breakWhere (ModuleHeader.breakWhere def))
   where
     def = ModuleHeader.defaultConfig
 
+    columns = configColumns config
+
+    breakWhere =
+        [ ("exports", ModuleHeader.Exports)
+        , ("single",  ModuleHeader.Single)
+        , ("inline",  ModuleHeader.Inline)
+        , ("always",  ModuleHeader.Always)
+        ]
+
 --------------------------------------------------------------------------------
 parseSimpleAlign :: Config -> A.Object -> A.Parser Step
 parseSimpleAlign c o = SimpleAlign.step

lib/Language/Haskell/Stylish/Printer.hs

@@ -41,6 +41,7 @@ module Language.Haskell.Stylish.Printer
   , removeLineComment
   , sep
   , groupAttachedComments
+  , groupWithoutComments
   , space
   , spaces
   , suffix
@@ -73,7 +74,7 @@ import           Control.Monad.Reader            (MonadReader, ReaderT(..), asks
 import           Control.Monad.State             (MonadState, State)
 import           Control.Monad.State             (runState)
 import           Control.Monad.State             (get, gets, modify, put)
-import           Data.Foldable                   (find)
+import           Data.Foldable                   (find, toList)
 import           Data.Functor                    ((<&>))
 import           Data.List                       (delete, isPrefixOf)
 import           Data.List.NonEmpty              (NonEmpty(..))
@@ -427,6 +428,17 @@ groupAttachedComments = go
 
     go _ = pure []
 
+-- | A view on 'groupAttachedComments': return 'Just' when there is just a
+--   one big group without any comments.
+groupWithoutComments
+    :: [([AnnotationComment], NonEmpty (Located a))]
+    -> Maybe [Located a]
+groupWithoutComments grouped
+    | all (null . fst) grouped
+    = Just $ concatMap (toList . snd) grouped
+    | otherwise
+    = Nothing
+
 modifyCurrentLine :: (String -> String) -> P ()
 modifyCurrentLine f = do
     s0 <- get

lib/Language/Haskell/Stylish/Step/ModuleHeader.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase     #-}
 module Language.Haskell.Stylish.Step.ModuleHeader
   ( Config (..)
+  , BreakWhere (..)
   , defaultConfig
   , step
   ) where
@@ -40,25 +41,31 @@ import qualified Language.Haskell.Stylish.Step.Imports as Imports
 
 
 data Config = Config
-    { indent         :: Int
-    , sort           :: Bool
-    , separateLists  :: Bool
-    , breakOnlyWhere :: Bool
+    { indent        :: Int
+    , sort          :: Bool
+    , separateLists :: Bool
+    , breakWhere    :: BreakWhere
     }
 
+data BreakWhere
+    = Exports
+    | Single
+    | Inline
+    | Always
+
 defaultConfig :: Config
 defaultConfig = Config
-    { indent         = 4
-    , sort           = True
-    , separateLists  = True
-    , breakOnlyWhere = False
+    { indent        = 4
+    , sort          = True
+    , separateLists = True
+    , breakWhere    = Exports
     }
 
-step :: Config -> Step
-step = makeStep "Module header" . printModuleHeader
+step :: Maybe Int -> Config -> Step
+step maxCols = makeStep "Module header" . printModuleHeader maxCols
 
-printModuleHeader :: Config -> Lines -> Module -> Lines
-printModuleHeader conf ls m =
+printModuleHeader :: Maybe Int -> Config -> Lines -> Module -> Lines
+printModuleHeader maxCols conf ls m =
   let
     header = moduleHeader m
     name = rawModuleName header
@@ -73,8 +80,7 @@ printModuleHeader conf ls m =
       & dropAfterLocated exports
       & dropBeforeLocated name
 
-    -- TODO: pass max columns?
-    printedModuleHeader = runPrinter_ (PrinterConfig Nothing) relevantComments
+    printedModuleHeader = runPrinter_ (PrinterConfig maxCols) relevantComments
         m (printHeader conf name exports haddocks)
 
     getBlock loc =
@@ -144,13 +150,27 @@ printHeader conf mname mexps _ = do
 
   case mexps of
     Nothing -> when (isJust mname) do
-      if breakOnlyWhere conf
-        then do
+      case breakWhere conf of
+        Always -> do
           newline
           spaces (indent conf)
-        else space
+        _      -> space
       putText "where"
-    Just exps -> printExportList conf exps
+    Just (L loc exps) -> do
+      exportsWithComments <- fmap (second doSort) <$> groupAttachedComments exps
+      case breakWhere conf of
+        Single
+          | Just exportsWithoutComments <- groupWithoutComments exportsWithComments
+          , length exportsWithoutComments <= 1
+          -> printSingleLineExportList conf (L loc exportsWithoutComments)
+        Inline
+          | Just exportsWithoutComments <- groupWithoutComments exportsWithComments
+          -> wrapping
+               (printSingleLineExportList conf (L loc exportsWithoutComments))
+               (printMultiLineExportList conf (L loc exportsWithComments))
+        _ -> printMultiLineExportList conf (L loc exportsWithComments)
+  where
+    doSort = if sort conf then NonEmpty.sortBy compareLIE else id
 
 attachEolComment :: SrcSpan -> P ()
 attachEolComment = \case
@@ -164,12 +184,25 @@ attachEolCommentEnd = \case
   RealSrcSpan rspan ->
     removeLineComment (srcSpanEndLine rspan) >>= mapM_ \c -> space >> putComment c
 
-printExportList :: Config -> Located [GHC.LIE GhcPs] -> P ()
-printExportList conf (L srcLoc exports) = do
+printSingleLineExportList :: Config -> Located [GHC.LIE GhcPs] -> P ()
+printSingleLineExportList conf (L srcLoc exports) = do
+  space >> putText "("
+  printInlineExports exports
+  putText ")" >> space >> putText "where" >> attachEolCommentEnd srcLoc
+  where
+    printInlineExports :: [GHC.LIE GhcPs] -> P ()
+    printInlineExports = \case
+      []     -> pure ()
+      [e]    -> printExport conf e
+      (e:es) -> printExport conf e >> comma >> space >> printInlineExports es
+
+printMultiLineExportList
+     :: Config
+     -> Located [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))]
+     -> P ()
+printMultiLineExportList conf (L srcLoc exportsWithComments) = do
   newline
-  doIndent >> putText "(" >> when (notNull exports) space
-
-  exportsWithComments <- fmap (second doSort) <$> groupAttachedComments exports
+  doIndent >> putText "(" >> when (notNull exportsWithComments) space
 
   printExports exportsWithComments
 
@@ -191,11 +224,9 @@ printExportList conf (L srcLoc exports) = do
     doIndent = spaces (indent conf)
     doHang = pad (indent conf + 2)
 
-    doSort = if sort conf then NonEmpty.sortBy compareLIE else id
-
     printExports :: [([AnnotationComment], NonEmpty (GHC.LIE GhcPs))] -> P ()
     printExports (([], firstInGroup :| groupRest) : rest) = do
-      printExport firstInGroup
+      printExport conf firstInGroup
       newline
       doIndent
       printExportsGroupTail groupRest
@@ -204,7 +235,7 @@ printExportList conf (L srcLoc exports) = do
       putComment firstComment >> newline >> doIndent
       forM_ comments \c -> doHang >> putComment c >> newline >> doIndent
       doHang
-      printExport firstExport
+      printExport conf firstExport
       newline
       doIndent
       printExportsGroupTail groupRest
@@ -216,14 +247,14 @@ printExportList conf (L srcLoc exports) = do
     printExportsTail = mapM_ \(comments, exported) -> do
       forM_ comments \c -> doHang >> putComment c >> newline >> doIndent
       forM_ exported \export -> do
-        comma >> space >> printExport export
+        comma >> space >> printExport conf export
         newline >> doIndent
 
     printExportsGroupTail :: [GHC.LIE GhcPs] -> P ()
     printExportsGroupTail (x : xs) = printExportsTail [([], x :| xs)]
     printExportsGroupTail []       = pure ()
 
-    -- NOTE(jaspervdj): This code is almost the same as the import printing
-    -- in 'Imports' and should be merged.
-    printExport :: GHC.LIE GhcPs -> P ()
-    printExport = Imports.printImport (separateLists conf) . unLoc
+-- NOTE(jaspervdj): This code is almost the same as the import printing in
+-- 'Imports' and should be merged.
+printExport :: Config -> GHC.LIE GhcPs -> P ()
+printExport conf = Imports.printImport (separateLists conf) . unLoc