Add new configuration to ModuleHeader step (#357)

Add a new configuration to ModuleHeader step

Previously the formatter of module header would always add open
the bracket of the export list on the next line after the module name.

With this change, we give the user the ability to customize this behavior. The
open bracket ends up either on the same line as module name or on the
next line.

For backward compatibility, we keep the 'next_line' a default behavior.

Author: EncodePanda

data/stylish-haskell.yaml

@@ -40,6 +40,13 @@ steps:
   #     #   list contains comments as newlines will be required.
   #     # - always: always break before the "where".
   #     break_where: exports
+  #
+  #     # Where to put open bracket
+  #     # Possible values:
+  #     # - same_line: put open bracket on the same line as the module name, before the
+  #     #              comment of the module
+  #     # - next_line: put open bracket on the next line, after module comment
+  #     open_bracket: next_line
 
   # Format record definitions. This is disabled by default.
   #

lib/Language/Haskell/Stylish/Config.hs

@@ -201,6 +201,7 @@ parseModuleHeader config o = fmap (ModuleHeader.step columns) $ ModuleHeader.Con
     <*> (o A..:? "sort"           A..!= ModuleHeader.sort          def)
     <*> (o A..:? "separate_lists" A..!= ModuleHeader.separateLists def)
     <*> (o A..:? "break_where"      >>= parseEnum breakWhere (ModuleHeader.breakWhere def))
+    <*> (o A..:? "open_bracket"     >>= parseEnum openBracket (ModuleHeader.openBracket def))
   where
     def = ModuleHeader.defaultConfig
 
@@ -213,6 +214,11 @@ parseModuleHeader config o = fmap (ModuleHeader.step columns) $ ModuleHeader.Con
         , ("always",  ModuleHeader.Always)
         ]
 
+    openBracket =
+        [ ("same_line", ModuleHeader.SameLine)
+        , ("next_line", ModuleHeader.NextLine)
+        ]
+
 --------------------------------------------------------------------------------
 parseSimpleAlign :: Config -> A.Object -> A.Parser Step
 parseSimpleAlign c o = SimpleAlign.step

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

@@ -3,6 +3,7 @@
 module Language.Haskell.Stylish.Step.ModuleHeader
   ( Config (..)
   , BreakWhere (..)
+  , OpenBracket (..)
   , defaultConfig
   , step
   ) where
@@ -45,20 +46,28 @@ data Config = Config
     , sort          :: Bool
     , separateLists :: Bool
     , breakWhere    :: BreakWhere
+    , openBracket   :: OpenBracket
     }
 
+data OpenBracket
+    = SameLine
+    | NextLine
+    deriving (Eq, Show)
+
 data BreakWhere
     = Exports
     | Single
     | Inline
     | Always
+    deriving (Eq, Show)
 
 defaultConfig :: Config
 defaultConfig = Config
     { indent        = 4
     , sort          = True
     , separateLists = True
     , breakWhere    = Exports
+    , openBracket   = NextLine
     }
 
 step :: Maybe Int -> Config -> Step
@@ -142,36 +151,64 @@ printHeader
   -> Maybe GHC.LHsDocString
   -> P ()
 printHeader conf mname mexps _ = do
-  forM_ mname \(L loc name) -> do
+  forM_ mname \(L _ name) -> do
     putText "module"
     space
     putText (showOutputable name)
-    attachEolComment loc
 
   case mexps of
     Nothing -> when (isJust mname) do
+      forM_ mname \(L nloc _) -> attachEolComment nloc
       case breakWhere conf of
         Always -> do
           newline
           spaces (indent conf)
         _      -> space
       putText "where"
     Just (L loc exps) -> do
+      moduleComment <- getModuleComment
       exportsWithComments <- fmap (second doSort) <$> groupAttachedComments exps
       case breakWhere conf of
         Single
           | Just exportsWithoutComments <- groupWithoutComments exportsWithComments
           , length exportsWithoutComments <= 1
-          -> printSingleLineExportList conf (L loc exportsWithoutComments)
+          -> do
+              attachModuleComment moduleComment
+              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)
+          -> do
+              wrapping
+               (   attachModuleComment moduleComment
+                >> printSingleLineExportList conf (L loc exportsWithoutComments))
+               (   attachOpenBracket
+                >> attachModuleComment moduleComment
+                >> printMultiLineExportList conf (L loc exportsWithComments))
+        _ -> do
+          attachOpenBracket
+          attachModuleComment moduleComment
+          printMultiLineExportList conf (L loc exportsWithComments)
   where
+
+    getModuleComment = do
+       maybemaybeComment <- traverse (\(L nloc _) -> removeModuleComment nloc) mname
+       pure $ join maybemaybeComment
+
+    attachModuleComment moduleComment =
+      mapM_ (\c -> space >> putComment c) moduleComment
+
     doSort = if sort conf then NonEmpty.sortBy compareLIE else id
 
+    attachOpenBracket
+      | openBracket conf == SameLine = putText " ("
+      | otherwise                    = pure ()
+
+removeModuleComment :: SrcSpan -> P (Maybe AnnotationComment)
+removeModuleComment = \case
+  UnhelpfulSpan _ -> pure Nothing
+  RealSrcSpan rspan ->
+    removeLineComment (srcSpanStartLine rspan)
+
 attachEolComment :: SrcSpan -> P ()
 attachEolComment = \case
   UnhelpfulSpan _ -> pure ()
@@ -202,8 +239,7 @@ printMultiLineExportList
      -> P ()
 printMultiLineExportList conf (L srcLoc exportsWithComments) = do
   newline
-  doIndent >> putText "(" >> when (notNull exportsWithComments) space
-
+  doIndent >> putText firstChar >> when (notNull exportsWithComments) space
   printExports exportsWithComments
 
   putText ")" >> space >> putText "where" >> attachEolCommentEnd srcLoc
@@ -221,6 +257,12 @@ printMultiLineExportList conf (L srcLoc exportsWithComments) = do
     -- > xxxx( -- Some comment
     -- > xxxxyyfoo
     -- > xxxx) where
+
+    firstChar =
+      case openBracket conf of
+        SameLine -> " "
+        NextLine -> "("
+
     doIndent = spaces (indent conf)
     doHang = pad (indent conf + 2)