stylish-haskell 0.12.2.0 → 0.13.0.0

raw patch · 19 files changed

+1183/−148 lines, 19 filesdep ~optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: optparse-applicative

API changes (from Hackage documentation)

Files

• CHANGELOG +12/−0
• README.markdown +21/−7
• data/stylish-haskell.yaml +34/−11
• lib/Language/Haskell/Stylish/Config.hs +25/−7
• lib/Language/Haskell/Stylish/Printer.hs +18/−2
• lib/Language/Haskell/Stylish/Step/Data.hs +13/−8
• lib/Language/Haskell/Stylish/Step/Imports.hs +30/−19
• lib/Language/Haskell/Stylish/Step/LanguagePragmas.hs +15/−3
• lib/Language/Haskell/Stylish/Step/ModuleHeader.hs +107/−27
• lib/Language/Haskell/Stylish/Step/SimpleAlign.hs +1/−1
• stylish-haskell.cabal +6/−5
• tests/Language/Haskell/Stylish/Regressions.hs +35/−0
• tests/Language/Haskell/Stylish/Step/Data/Tests.hs +104/−1
• tests/Language/Haskell/Stylish/Step/Imports/FelixTests.hs +4/−3
• tests/Language/Haskell/Stylish/Step/Imports/Tests.hs +105/−24
• tests/Language/Haskell/Stylish/Step/LanguagePragmas/Tests.hs +24/−1
• tests/Language/Haskell/Stylish/Step/ModuleHeader/Tests.hs +603/−27
• tests/Language/Haskell/Stylish/Tests/Util.hs +24/−2
• tests/TestSuite.hs +2/−0

@@ -1,5 +1,17 @@ # CHANGELOG +- 0.13.0.0 (2021-09-15)+     *  Don't remove ticks on promoted data types (by Jim McStanton)+     *  Add break_only_where option (by 1Computer1)+     *  Keep wildcard if present in IEThingWith (by Moisés Ackerman)+     *  Generalise break_only_where to allow single-line module headers+        (by Thomas Winant)+     *  Add new configuration to ModuleHeader step (by Pawel Szulc)+     *  Add a language pragma style "vertical_compact" (by Javran Cheng)+     *  Don't remove existential quantification (by Imuli)+     *  Add support for post qualified import formatting (by Moisés Ackerman)+     *  Bump `optparse-applicative` upper bound to 0.17+ - 0.12.2.0 (2020-10-08)      *  align: Add a new option for aligning only adjacent items (by 1Computer1)      *  align: Add support for aligning MultiWayIf syntax (by 1Computer1)

@@ -2,7 +2,7 @@  <img src="./assets/Logo/SVG/RoundedLogo.svg" width="100px"> -![Build Status](https://github.com/jaspervdj/patat/workflows/CI/badge.svg)+![Build Status](https://github.com/jaspervdj/stylish-haskell/workflows/CI/badge.svg)  ## Introduction @@ -37,7 +37,7 @@  Feature requests are welcome! Use the [issue tracker] for that. -[issue tracker]: https://github.com/jaspervdj/stylish-haskell/issues+[issue tracker]: https://github.com/haskell/stylish-haskell/issues  ## Example @@ -158,8 +158,22 @@   deriving (ToJSON) via Bar Foo ``` -## VIM integration+## Editor integration +### Haskell Language Server+[Haskell Language Server(HLS)][HLS] includes a [plugin][HLS stylish-haskell Plugin]+for stylish-haskell. By changing the formatting provider option+(`haskell.formattingProvider`) to `stylish-haskell` as described in+[HLS options][HLS option], any editors that support [Language Server Protocol][LSP]+can use stylish-haskell for formatting.++[HLS]: https://github.com/haskell/haskell-language-server+[HLS option]: https://github.com/haskell/haskell-language-server#language-specific-server-options+[HLS stylish-haskell Plugin]: https://github.com/haskell/haskell-language-server/blob/master/plugins/default/src/Ide/Plugin/StylishHaskell.hs+[LSP]: https://microsoft.github.io/language-server-protocol/++### VIM integration+ Since it works as a filter it is pretty easy to integrate this with VIM.  You can call@@ -192,7 +206,7 @@ [vim-stylish-haskell]: https://github.com/nbouscal/vim-stylish-haskell [vim-stylishask]: https://github.com/alx741/vim-stylishask -## Emacs integration+### Emacs integration  [haskell-mode] for Emacs supports `stylish-haskell`. For configuration, see [the “Using external formatters” section][haskell-mode/format] of the@@ -201,7 +215,7 @@ [haskell-mode]: https://github.com/haskell/haskell-mode [haskell-mode/format]: http://haskell.github.io/haskell-mode/manual/latest/Autoformating.html -## Atom integration+### Atom integration  [ide-haskell] for Atom supports `stylish-haskell`. @@ -210,7 +224,7 @@ [ide-haskell]: https://atom.io/packages/ide-haskell [atom-beautify]: Https://atom.io/packages/atom-beautify -## Visual Studio Code integration+### Visual Studio Code integration  [stylish-haskell-vscode] for VSCode supports `stylish-haskell`. @@ -220,7 +234,7 @@  You can quickly grab the latest binary and run `stylish-haskell` like so: -    curl -sL https://raw.github.com/jaspervdj/stylish-haskell/master/scripts/latest.sh | sh -s .+    curl -sL https://raw.github.com/haskell/stylish-haskell/master/scripts/latest.sh | sh -s .  Where the `.` can be replaced with the arguments you pass to `stylish-haskell`. 

@@ -30,6 +30,23 @@   #   #     # See `separate_lists` for the `imports` step.   #     separate_lists: true+  #+  #     # 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+  #+  #     # 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.   #@@ -258,22 +275,26 @@       # Default: false       space_surround: false -      # Enabling this argument will use the new GHC lib parse to format imports.+      # Post qualify option moves any qualifies found in import declarations+      # to the end of the declaration. This also adjust padding for any+      # unqualified import declarations.       #-      # This currently assumes a few things, it will assume that you want post-      # qualified imports. It is also not as feature complete as the old-      # imports formatting.+      # - true: Qualified as <module name> is moved to the end of the+      #   declaration.       #-      # It does not remove redundant lines or merge lines. As such, the full-      # feature scope is still pending.+      #   > import Data.Bar+      #   > import Data.Foo qualified as F       #-      # It _is_ however, a fine alternative if you are using features that are-      # not parseable by haskell src extensions and you're comfortable with the-      # presets.+      # - false: Qualified remains in the default location and unqualified+      #   imports are padded to align with qualified imports.       #+      #   > import           Data.Bar+      #   > import qualified Data.Foo as F+      #       # Default: false-      ghc_lib_parser: false+      post_qualify: false +   # Language pragmas   - language_pragmas:       # We can generate different styles of language pragma lists.@@ -283,7 +304,9 @@       # - compact: A more compact style.       #       # - compact_line: Similar to compact, but wrap each line with-      #   `{-#LANGUAGE #-}'.+      #   `{-# LANGUAGE #-}'.+      #+      # - vertical_compact: Similar to vertical, but use only one language pragma.       #       # Default: vertical.       style: vertical

@@ -196,13 +196,29 @@  -------------------------------------------------------------------------------- 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+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))+    <*> (o A..:? "open_bracket"     >>= parseEnum openBracket (ModuleHeader.openBracket def))   where     def = ModuleHeader.defaultConfig +    columns = configColumns config++    breakWhere =+        [ ("exports", ModuleHeader.Exports)+        , ("single",  ModuleHeader.Single)+        , ("inline",  ModuleHeader.Inline)+        , ("always",  ModuleHeader.Always)+        ]++    openBracket =+        [ ("same_line", ModuleHeader.SameLine)+        , ("next_line", ModuleHeader.NextLine)+        ]+ -------------------------------------------------------------------------------- parseSimpleAlign :: Config -> A.Object -> A.Parser Step parseSimpleAlign c o = SimpleAlign.step@@ -273,6 +289,7 @@       <*> (o A..:? "list_padding" >>= maybe (pure $ def Imports.listPadding) parseListPadding)       <*> o A..:? "separate_lists" A..!= def Imports.separateLists       <*> o A..:? "space_surround" A..!= def Imports.spaceSurround+      <*> o A..:? "post_qualify" A..!= def Imports.postQualified   where     def f = f Imports.defaultOptions @@ -320,9 +337,10 @@     <*> mkLanguage o   where     styles =-        [ ("vertical",     LanguagePragmas.Vertical)-        , ("compact",      LanguagePragmas.Compact)-        , ("compact_line", LanguagePragmas.CompactLine)+        [ ("vertical",         LanguagePragmas.Vertical)+        , ("compact",          LanguagePragmas.Compact)+        , ("compact_line",     LanguagePragmas.CompactLine)+        , ("vertical_compact", LanguagePragmas.VerticalCompact)         ]  

@@ -41,6 +41,7 @@   , removeLineComment   , sep   , groupAttachedComments+  , groupWithoutComments   , space   , spaces   , suffix@@ -57,6 +58,7 @@  -------------------------------------------------------------------------------- import           ApiAnnotation                   (AnnKeywordId(..), AnnotationComment(..))+import           BasicTypes                      (PromotionFlag(..)) import           GHC.Hs.Extension                (GhcPs, NoExtField(..)) import           GHC.Hs.Types                    (HsType(..)) import           Module                          (ModuleName, moduleNameString)@@ -72,7 +74,7 @@ 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(..))@@ -229,7 +231,10 @@     putRdrName op     space     putType rhs-  HsTyVar NoExtField _ rdrName ->+  HsTyVar NoExtField flag rdrName -> do+    case flag of+      IsPromoted  -> putText "'"+      NotPromoted -> pure ()     putRdrName rdrName   HsTyLit _ tp ->     putOutputable tp@@ -422,6 +427,17 @@       pure $ (comments, L rspan x :| sameGroupOf nextGroupStartM) : restGroups      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

@@ -357,19 +357,15 @@     putText "::"     space -    when (unLocated con_forall) do-      putText "forall"-      space-      sep space (fmap putOutputable $ hsq_explicit con_qvars)-      dot-      space-+    putForAll con_forall $ hsq_explicit con_qvars     forM_ con_mb_cxt (putContext cfg . unLocated)     putType con_res_ty    XConDecl x ->     noExtCon x-  ConDeclH98{..} ->+  ConDeclH98{..} -> do+    putForAll con_forall con_ex_tvs+    forM_ con_mb_cxt (putContext cfg . unLocated)     case con_args of       InfixCon arg1 arg2 -> do         putType arg1@@ -466,6 +462,15 @@       [ "Language.Haskell.Stylish.Step.Data.putNewtypeConstructor: "       , "GADT encountered in newtype"       ]++putForAll :: Located Bool -> [Located (HsTyVarBndr GhcPs)] -> P ()+putForAll forall ex_tvs =+  when (unLocated forall) do+    putText "forall"+    space+    sep space (fmap putOutputable ex_tvs)+    dot+    space  putContext :: Config -> HsContext GhcPs -> P () putContext Config{..} = suffix (space >> putText "=>" >> space) . \case

@@ -61,6 +61,7 @@     , listPadding     :: ListPadding     , separateLists   :: Bool     , spaceSurround   :: Bool+    , postQualified   :: Bool     } deriving (Eq, Show)  defaultOptions :: Options@@ -73,6 +74,7 @@     , listPadding     = LPConstant 4     , separateLists   = True     , spaceSurround   = False+    , postQualified   = False     }  data ListPadding@@ -143,8 +145,8 @@     -> NonEmpty (Located Import) -> Lines formatImports maxCols options m moduleStats rawGroup =   runPrinter_ (PrinterConfig maxCols) [] m do-  let -     +  let+     group       = NonEmpty.sortWith unLocated rawGroup       & mergeImports@@ -177,25 +179,31 @@    when (isSafe decl) (putText "safe" >> space) -  case (isQualified decl, isAnyQualified stats) of-    (True, _) -> putText "qualified" >> space-    (_, True) -> putText "         " >> space-    _         -> pure ()--  moduleNamePosition <- length <$> getCurrentLine-  forM_ (ideclPkgQual decl') $ \pkg -> putText (stringLiteral pkg) >> space-  putText (moduleName decl)+  let+    module_ = do+      moduleNamePosition <- length <$> getCurrentLine+      forM_ (ideclPkgQual decl') $ \pkg -> putText (stringLiteral pkg) >> space+      putText (moduleName decl)+      -- Only print spaces if something follows.+      when padNames $+        when (isJust (ideclAs decl') || isHiding decl ||+                not (null $ ideclHiding decl')) $+          putText $+            replicate (isLongestImport stats - importModuleNameLength decl) ' '+      pure moduleNamePosition -  -- Only print spaces if something follows.-  when padNames $-    when (isJust (ideclAs decl') || isHiding decl ||-            not (null $ ideclHiding decl')) $-      putText $-        replicate (isLongestImport stats - importModuleNameLength decl) ' '+  moduleNamePosition <-+    case (postQualified, isQualified decl, isAnyQualified stats) of+      (False, True , _   ) -> putText "qualified" *> space *> module_+      (False, _    , True) -> putText "         " *> space *> module_+      (True , True , _   ) -> module_ <* space <* putText "qualified"+      _                    -> module_    beforeAliasPosition <- length <$> getCurrentLine-  forM_ (ideclAs decl') \(L _ name) ->++  forM_ (ideclAs decl') \(L _ name) -> do     space >> putText "as" >> space >> putText (moduleNameString name)+   afterAliasPosition <- length <$> getCurrentLine    when (isHiding decl) (space >> putText "hiding")@@ -323,11 +331,14 @@     putText "module"     space     putText (moduleNameString m)-printImport separateLists (IEThingWith _ name _wildcard imps _) = do+printImport separateLists (IEThingWith _ name wildcard imps _) = do     printIeWrappedName name     when separateLists space+    let ellipsis = case wildcard of+          IEWildcard _position -> [putText ".."]+          NoIEWildcard         -> []     parenthesize $-      sep (comma >> space) (printIeWrappedName <$> imps)+      sep (comma >> space) (ellipsis <> fmap printIeWrappedName imps) printImport _ (IEGroup _ _ _ ) =     error "Language.Haskell.Stylish.Printer.Imports.printImportExport: unhandled case 'IEGroup'" printImport _ (IEDoc _ _) =

@@ -37,6 +37,7 @@     = Vertical     | Compact     | CompactLine+    | VerticalCompact     deriving (Eq, Show)  @@ -74,6 +75,16 @@   --------------------------------------------------------------------------------+verticalCompactPragmas :: String -> [String] -> Lines+verticalCompactPragmas lg pragmas' =+  [ "{-# " <> lg+  , "    " <> head pragmas'+  ]+  <> [ "  , "  <> pragma | pragma <- tail pragmas']+  <> [ "  #-}"]+++-------------------------------------------------------------------------------- truncateComma :: String -> String truncateComma ""     = "" truncateComma xs@@ -83,9 +94,10 @@  -------------------------------------------------------------------------------- prettyPragmas :: String -> Maybe Int -> Int -> Bool -> Style -> [String] -> Lines-prettyPragmas lp _    longest align Vertical    = verticalPragmas lp longest align-prettyPragmas lp cols _       _     Compact     = compactPragmas lp cols-prettyPragmas lp cols _       align CompactLine = compactLinePragmas lp cols align+prettyPragmas lp _    longest align Vertical        = verticalPragmas lp longest align+prettyPragmas lp cols _       _     Compact         = compactPragmas lp cols+prettyPragmas lp cols _       align CompactLine     = compactLinePragmas lp cols align+prettyPragmas lp _    _       _     VerticalCompact = verticalCompactPragmas lp   --------------------------------------------------------------------------------

@@ -2,6 +2,8 @@ {-# LANGUAGE LambdaCase     #-} module Language.Haskell.Stylish.Step.ModuleHeader   ( Config (..)+  , BreakWhere (..)+  , OpenBracket (..)   , defaultConfig   , step   ) where@@ -43,20 +45,36 @@     { indent        :: Int     , 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 :: 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@@ -71,8 +89,7 @@       & 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 =@@ -134,17 +151,64 @@   -> 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 -  maybe-    (when (isJust mname) do newline >> spaces (indent conf) >> putText "where")-    (printExportList conf)-    mexps+  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+          -> do+              attachModuleComment moduleComment+              printSingleLineExportList conf (L loc exportsWithoutComments)+        Inline+          | Just exportsWithoutComments <- groupWithoutComments 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 ()@@ -157,13 +221,25 @@   RealSrcSpan rspan ->     removeLineComment (srcSpanEndLine rspan) >>= mapM_ \c -> space >> putComment c -printExportList :: Config -> Located [GHC.LIE GhcPs] -> P ()-printExportList conf (L srcLoc exports) = do-  newline-  doIndent >> putText "(" >> when (notNull exports) space--  exportsWithComments <- fmap (second doSort) <$> groupAttachedComments exports+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 firstChar >> when (notNull exportsWithComments) space   printExports exportsWithComments    putText ")" >> space >> putText "where" >> attachEolCommentEnd srcLoc@@ -181,14 +257,18 @@     -- > xxxx( -- Some comment     -- > xxxxyyfoo     -- > xxxx) where++    firstChar =+      case openBracket conf of+        SameLine -> " "+        NextLine -> "("+     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@@ -197,7 +277,7 @@       putComment firstComment >> newline >> doIndent       forM_ comments \c -> doHang >> putComment c >> newline >> doIndent       doHang-      printExport firstExport+      printExport conf firstExport       newline       doIndent       printExportsGroupTail groupRest@@ -209,14 +289,14 @@     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

@@ -186,7 +186,7 @@  -------------------------------------------------------------------------------- step :: Maybe Int -> Config -> Step-step maxColumns config@(Config {..}) = makeStep "Cases" $ \ls module' ->+step maxColumns config = makeStep "Cases" $ \ls module' ->     let changes             :: (S.Located (Hs.HsModule Hs.GhcPs) -> [a])             -> (a -> [[Alignable S.RealSrcSpan]])

@@ -1,8 +1,8 @@ Cabal-version: 2.4 Name:          stylish-haskell-Version:       0.12.2.0+Version:       0.13.0.0 Synopsis:      Haskell code prettifier-Homepage:      https://github.com/jaspervdj/stylish-haskell+Homepage:      https://github.com/haskell/stylish-haskell License:       BSD-3-Clause License-file:  LICENSE Author:        Jasper Van der Jeugt <m@jaspervdj.be>@@ -16,7 +16,7 @@      . -    <https://github.com/jaspervdj/stylish-haskell/blob/master/README.markdown>+    <https://github.com/haskell/stylish-haskell/blob/master/README.markdown>  Extra-source-files:   CHANGELOG,@@ -89,7 +89,7 @@   Build-depends:     stylish-haskell,     strict               >= 0.3  && < 0.5,-    optparse-applicative >= 0.12 && < 0.16,+    optparse-applicative >= 0.12 && < 0.17,     -- Copied from regular dependencies...     aeson            >= 0.6    && < 1.6,     base             >= 4.8    && < 5,@@ -147,6 +147,7 @@     Language.Haskell.Stylish.Step.TrailingWhitespace.Tests     Language.Haskell.Stylish.Step.UnicodeSyntax     Language.Haskell.Stylish.Step.UnicodeSyntax.Tests+    Language.Haskell.Stylish.Regressions     Language.Haskell.Stylish.Tests     Language.Haskell.Stylish.Tests.Util     Language.Haskell.Stylish.Util@@ -179,4 +180,4 @@  Source-repository head   Type:     git-  Location: https://github.com/jaspervdj/stylish-haskell+  Location: https://github.com/haskell/stylish-haskell

@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedLists   #-}+{-# LANGUAGE OverloadedStrings #-}+module Language.Haskell.Stylish.Regressions+  ( tests+  ) where++import           Language.Haskell.Stylish.Step.Imports+import           Language.Haskell.Stylish.Tests.Util (testStep)+import           Test.Framework                      (Test, testGroup)+import           Test.Framework.Providers.HUnit      (testCase)+import           Test.HUnit                          (Assertion, (@=?))+++tests :: Test+tests = testGroup "Language.Haskell.Stylish.Regressions"+    [ testCase "case 00 (#198)" case00+    ]+-- | Error parsing '(,) #198+--+-- See https://github.com/haskell/stylish-haskell/issues/198+case00 :: Assertion+case00 = expected @=? testStep (step (Just 80) $ importStepConfig Global) input+  where+    input = unlines+      [ "{-# LANGUAGE TemplateHaskell #-}"+      , ""+      , "import           Language.Haskell.TH.Syntax"+      , ""+      , "main = print $ showName '(,)"+      ]++    expected = input++importStepConfig :: ImportAlign -> Options+importStepConfig align = defaultOptions { importAlign = align }

@@ -70,6 +70,11 @@     , testCase "case 55" case55     , testCase "case 56" case56     , testCase "case 57" case57+    , testCase "case 58" case58+    , testCase "case 59" case59+    , testCase "case 60" case60+    , testCase "case 61 (issue 282)" case61+    , testCase "case 62 (issue 273)" case62     ]  case00 :: Assertion@@ -449,7 +454,7 @@  -- | Should not break Enums (data without records) formatting ----- See https://github.com/jaspervdj/stylish-haskell/issues/262+-- See https://github.com/haskell/stylish-haskell/issues/262 case20 :: Assertion case20 = input @=? testStep (step indentIndentStyle) input   where@@ -1273,6 +1278,104 @@     , "    , fooBarBar :: Int"     , "    }"     ]++-- | Should not break DataKinds in records+--+-- See https://github.com/haskell/stylish-haskell/issues/330+case58 :: Assertion+case58 = expected @=? testStep (step sameIndentStyle) input+  where+    input = unlines+      [ "module Herp where"+      , ""+      , "data Foo a = Foo"+      , "               { foo :: Foo 'True"+      , "               }"+      ]++    expected = input++-- | Don't remove existential quantification+--+-- See https://github.com/haskell/stylish-haskell/issues/339+case59 :: Assertion+case59 = assertSnippet (step defaultConfig)+    [ "data Foo = forall (a :: *) . Bar a" ]+    [ "data Foo = forall (a :: *). Bar a" ]++-- | Don't remove existential quantification+--+-- See https://github.com/haskell/stylish-haskell/issues/339+case60 :: Assertion+case60 = assertSnippet (step defaultConfig)+    [ "data Foo = forall a . Bar a" ]+    [ "data Foo = forall a. Bar a" ]++-- | Formatting duplicates haddock comments #282+--+-- Regression test for https://github.com/haskell/stylish-haskell/issues/282+case61 :: Assertion+case61 = expected @=? testStep (step sameIndentStyle) input+  where+    input = unlines+      [ "module Herp where"+      , ""+      , "data Game = Game { _board    :: Board -- ^ Board state"+      , "                , _time     :: Int   -- ^ Time elapsed"+      , "                , _paused   :: Bool  -- ^ Playing vs. paused"+      , "                , _speed    :: Float -- ^ Speed in [0..1]"+      , "                , _interval :: TVar Int -- ^ Interval kept in TVar"+      , "                }"+      ]++    expected = unlines+      [ "module Herp where"+      , ""+      , "data Game = Game"+      , "              { _board :: Board"+      , "                -- ^ Board state"+      , "              , _time :: Int"+      , "                -- ^ Time elapsed"+      , "              , _paused :: Bool"+      , "                -- ^ Playing vs. paused"+      , "              , _speed :: Float"+      , "                -- ^ Speed in [0..1]"+      , "              , _interval :: TVar Int"+      , "                -- ^ Interval kept in TVar"+      , "              }"+      ]++-- | Comment issues with record formatting #273+--+-- Regression test for https://github.com/haskell/stylish-haskell/issues/273+case62 :: Assertion+case62 = expected @=? testStep (step sameIndentStyle) input+  where+    input = unlines+      [ "module Herp where"+      , ""+      , "data Foo = Foo"+      , "   { -- | This is a comment above some line."+      , "    -- It can span multiple lines."+      , "     fooName :: String"+      , "   , fooAge :: Int"+      , "     -- ^ This is a comment below some line."+      , "     -- It can span multiple lines."+      , "   }"+      ]++    expected = unlines+      [ "module Herp where"+      , ""+      , "data Foo = Foo"+      , "             { -- | This is a comment above some line."+      , "             -- It can span multiple lines."+      , "               fooName :: String"+      , "             , fooAge :: Int"+      , "               -- ^ This is a comment below some line."+      , "               -- It can span multiple lines."+      , "             }"+      ]  sameSameStyle :: Config sameSameStyle = Config SameLine SameLine 2 2 False True SameLine False True NoMaxColumns

@@ -1,15 +1,16 @@ -- | Tests contributed by Felix Mulder as part of--- <https://github.com/jaspervdj/stylish-haskell/pull/293>.+-- <https://github.com/haskell/stylish-haskell/pull/293>. module Language.Haskell.Stylish.Step.Imports.FelixTests   ( tests   ) where  --------------------------------------------------------------------------------+import           GHC.Stack                             (HasCallStack,+                                                        withFrozenCallStack)+import           Prelude                               hiding (lines) import           Test.Framework                        (Test, testGroup) import           Test.Framework.Providers.HUnit        (testCase) import           Test.HUnit                            (Assertion)-import           GHC.Stack                             (HasCallStack, withFrozenCallStack)-import           Prelude                               hiding (lines)  -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Module

@@ -62,6 +62,13 @@     , testCase "case 28" case28     , testCase "case 29" case29     , testCase "case 30" case30+    , testCase "case 31" case31+    , testCase "case 32" case32+    , testCase "case 33" case33+    , testCase "case 34" case34+    , testCase "case 35" case35+    , testCase "case 36" case36+    , testCase "case 37" case37     ]  @@ -190,7 +197,7 @@ case08 :: Assertion case08 =   let-    options = Options Global WithAlias True Inline Inherit (LPConstant 4) True False+    options = Options Global WithAlias True Inline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options) input     [ "module Herp where"@@ -214,7 +221,7 @@ case08b :: Assertion case08b =   let-    options = Options Global WithModuleName True Inline Inherit (LPConstant 4) True False+    options = Options Global WithModuleName True Inline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options) input     ["module Herp where"@@ -237,7 +244,7 @@ case09 :: Assertion case09 =   let-    options = Options Global WithAlias True Multiline Inherit (LPConstant 4) True False+    options = Options Global WithAlias True Multiline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options) input     [ "module Herp where"@@ -272,7 +279,7 @@ case10 :: Assertion case10 =   let-    options = Options Group WithAlias True Multiline Inherit (LPConstant 4) True False+    options = Options Group WithAlias True Multiline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 40) options) input     [ "module Herp where"@@ -313,7 +320,7 @@ case11 :: Assertion case11 =   let-    options = Options Group NewLine True Inline Inherit (LPConstant 4) True False+    options = Options Group NewLine True Inline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options) input     [ "module Herp where"@@ -340,7 +347,7 @@ case11b :: Assertion case11b =   let-    options = Options Group WithModuleName True Inline Inherit (LPConstant 4) True False+    options = Options Group WithModuleName True Inline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options) input     [ "module Herp where"@@ -363,7 +370,7 @@ case12 :: Assertion case12 =   let-    options = Options Group NewLine True Inline Inherit (LPConstant 2) True False+    options = Options Group NewLine True Inline Inherit (LPConstant 2) True False False   in     assertSnippet (step (Just 80) options)     [ "import Data.List (map)"@@ -377,7 +384,7 @@ case12b :: Assertion case12b =   let-    options = Options Group WithModuleName True Inline Inherit (LPConstant 2) True False+    options = Options Group WithModuleName True Inline Inherit (LPConstant 2) True False False   in     assertSnippet (step (Just 80) options)     ["import Data.List (map)"]@@ -388,7 +395,7 @@ case13 :: Assertion case13 =   let-    options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False+    options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options)     [ "import qualified Data.List as List (concat, foldl, foldr, head, init,"@@ -402,7 +409,7 @@ case13b :: Assertion case13b =   let-    options = Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False+    options = Options None WithModuleName True InlineWithBreak Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options)     [ "import qualified Data.List as List (concat, foldl, foldr, head, init,"@@ -418,7 +425,7 @@ case14 :: Assertion case14 =   let-    options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False+    options = Options None WithAlias True InlineWithBreak Inherit (LPConstant 10) True False False   in     assertSnippet (step (Just 80) options)     [ "import qualified Data.List as List (concat, map, null, reverse, tail, (++))"@@ -431,7 +438,7 @@ case15 :: Assertion case15 =   let-    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False+    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options)     [ "import Data.Acid (AcidState)"@@ -456,7 +463,7 @@ case16 :: Assertion case16 =   let-    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) False False+    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) False False False   in     assertSnippet (step (Just 80) options)     [ "import Data.Acid (AcidState)"@@ -479,7 +486,7 @@ case17 :: Assertion case17 =   let-    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False+    options = Options None AfterAlias True Multiline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 80) options)     [ "import Control.Applicative (Applicative ((<*>),pure))"@@ -496,7 +503,7 @@ case18 :: Assertion case18 =   let-    options = Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False+    options = Options None AfterAlias True InlineToMultiline Inherit (LPConstant 4) True False False   in     assertSnippet (step (Just 40) options)     [ "import Data.Foo as Foo (Bar, Baz, Foo)"@@ -523,7 +530,7 @@ case19 :: Assertion case19 =   let-    options = Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False+    options = Options Global NewLine True InlineWithBreak RightAfter (LPConstant 17) True False False   in     assertSnippet (step (Just 40) options) case19input        ----------------------------------------@@ -539,7 +546,7 @@ case19b :: Assertion case19b =   let-    options = Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False+    options = Options File NewLine True InlineWithBreak RightAfter (LPConstant 17) True False False   in     assertSnippet (step (Just 40) options) case19input        ----------------------------------------@@ -554,7 +561,7 @@ case19c :: Assertion case19c =   let-    options = Options File NewLine True InlineWithBreak RightAfter LPModuleName True False+    options = Options File NewLine True InlineWithBreak RightAfter LPModuleName True False False   in     assertSnippet (step (Just 40) options) case19input        ----------------------------------------@@ -569,7 +576,7 @@ case19d :: Assertion case19d =   let-    options = Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False+    options = Options Global NewLine True InlineWithBreak RightAfter LPModuleName True False False   in     assertSnippet (step (Just 40) options) case19input        ----------------------------------------@@ -665,7 +672,7 @@ case23 :: Assertion case23 =   let-    options = Options None AfterAlias False Inline Inherit (LPConstant 4) True True+    options = Options None AfterAlias False Inline Inherit (LPConstant 4) True True False   in     assertSnippet (step (Just 40) options)     [ "import Data.Acid (AcidState)"@@ -690,7 +697,7 @@ case23b :: Assertion case23b =   let-    options = Options None WithModuleName False Inline Inherit (LPConstant 4) True True+    options = Options None WithModuleName False Inline Inherit (LPConstant 4) True True False   in     assertSnippet (step (Just 40) options)     [ "import Data.Acid (AcidState)"@@ -716,7 +723,7 @@ case24 :: Assertion case24 =   let-    options = Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True+    options = Options None AfterAlias False InlineWithBreak Inherit (LPConstant 4) True True False   in     assertSnippet (step (Just 40) options)     [ "import Data.Acid (AcidState)"@@ -740,7 +747,7 @@ case25 :: Assertion case25 =   let-    options = Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False+    options = Options Group AfterAlias False Multiline Inherit (LPConstant 4) False False False   in     assertSnippet (step (Just 80) options)     [ "import Data.Acid (AcidState)"@@ -807,7 +814,7 @@     , "import Data.Set (empty, nub)"     ]     [ "import           Control.Monad"-    ,  "import qualified Data.Aeson         as JSON"+    , "import qualified Data.Aeson         as JSON"     , "import           Data.Default.Class (Default (def))"     , ""     , "import           Data.Maybe         (Maybe (Just, Nothing))"@@ -842,3 +849,77 @@ case30 = assertSnippet (step Nothing defaultOptions {separateLists = False})     ["import           Data.Monoid (Monoid (..))"]     ["import           Data.Monoid (Monoid(..))"]++--------------------------------------------------------------------------------+case31 :: Assertion+case31 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    ["import           Data.Monoid (Monoid (..))"]+    ["import Data.Monoid (Monoid (..))"]++--------------------------------------------------------------------------------+case32 :: Assertion+case32 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    ["import qualified Data.Monoid as M"]+    ["import Data.Monoid qualified as M"]++--------------------------------------------------------------------------------+case33 :: Assertion+case33 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    [ "import Data.Default.Class (Default(def))"+    , "import qualified Data.Aeson as JSON"+    , "import qualified Data.Aeson as JSON"+    , "import Control.Monad"+    , "import Control.Monad"+    , ""+    , "import Data.Maybe (Maybe   (Just, Nothing))"+    , "import qualified Data.Maybe.Extra (Maybe(Just, Nothing))"+    , ""+    , "import Data.Foo (Foo (Foo,Bar), Goo(Goo))"+    , "import Data.Foo (Foo (Foo,Bar))"+    , "import Data.Set (empty, intersect)"+    , "import Data.Set (empty, nub)"+    ]+    [ "import Control.Monad"+    , "import Data.Aeson         qualified as JSON"+    , "import Data.Default.Class (Default (def))"+    , ""+    , "import Data.Maybe         (Maybe (Just, Nothing))"+    , "import Data.Maybe.Extra   qualified (Maybe (Just, Nothing))"+    , ""+    , "import Data.Foo           (Foo (Bar, Foo), Goo (Goo))"+    , "import Data.Set           (empty, intersect, nub)"+    ]++--------------------------------------------------------------------------------+case34 :: Assertion+case34 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    [ "import qualified Data.Aeson as JSON (Value)"+    ]+    [ "import Data.Aeson qualified as JSON (Value)"+    ]++--------------------------------------------------------------------------------+case35 :: Assertion+case35 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    [ "import Data.Aeson qualified as JSON (Value)"+    ]+    [ "import Data.Aeson qualified as JSON (Value)"+    ]++--------------------------------------------------------------------------------+case36 :: Assertion+case36 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    [ "import qualified Data.Aeson as JSON (Value)"+    , "import qualified Data.Aeson as JSON (encode, decode)"+    ]+    [ "import Data.Aeson qualified as JSON (Value, decode, encode)"+    ]++--------------------------------------------------------------------------------+case37 :: Assertion+case37 = assertSnippet (step Nothing defaultOptions {postQualified = True})+    [ "import Data.Aeson qualified as JSON (Value)"+    , "import Data.Aeson qualified as JSON (encode, decode)"+    ]+    [ "import Data.Aeson qualified as JSON (Value, decode, encode)"+    ]

@@ -8,7 +8,7 @@ -------------------------------------------------------------------------------- import Test.Framework                 (Test, testGroup) import Test.Framework.Providers.HUnit (testCase)-import Test.HUnit                     (Assertion)+import Test.HUnit                     (Assertion, (@=?))   --------------------------------------------------------------------------------@@ -32,6 +32,7 @@     , testCase "case 11" case11     , testCase "case 12" case12     , testCase "case 13" case13+    , testCase "case 14" case14     ]  lANG :: String@@ -226,4 +227,26 @@         [ "{-# LANGUAGE BangPatterns  #-}"         , "{-# LANGUAGE DeriveFunctor #-}"         , "main = let !x = 1 + 1 in print x"+        ]++--------------------------------------------------------------------------------+case14 :: Assertion+case14 = expected @=? testStep (step Nothing VerticalCompact False False "language") input+  where+    input = unlines+        [ "{-# LANGUAGE ViewPatterns, OverloadedStrings #-}"+        , "{-# LANGUAGE TemplateHaskell, ViewPatterns #-}"+        , "{-# LANGUAGE ScopedTypeVariables, NoImplicitPrelude #-}"+        , "module Main where"+        ]++    expected = unlines+        [ "{-# language"+        , "    NoImplicitPrelude"+        , "  , OverloadedStrings"+        , "  , ScopedTypeVariables"+        , "  , TemplateHaskell"+        , "  , ViewPatterns"+        , "  #-}"+        , "module Main where"         ]

@@ -5,6 +5,7 @@  -------------------------------------------------------------------------------- import           Prelude                                    hiding (lines)+import           Data.Function((&)) import           Test.Framework                             (Test, testGroup) import           Test.Framework.Providers.HUnit             (testCase) import           Test.HUnit                                 (Assertion)@@ -17,37 +18,86 @@ -------------------------------------------------------------------------------- tests :: Test tests = testGroup "Language.Haskell.Stylish.Printer.ModuleHeader"-    [ testCase "Hello world" ex0+    [ testCase "Does not indent absent export list" ex0+    , testCase "Does not indent absent export list, open_bracket = same_line" ex0a     , testCase "Empty exports list" ex1+    , testCase "Empty exports list , open_bracket = same_line" ex1a     , testCase "Single exported variable" ex2+    , testCase "Single exported variable, open_bracket = same_line" ex2a     , testCase "Multiple exported variables" ex3+    , testCase "Multiple exported variables, open_bracket = same_line" ex3a     , testCase "Only reformats module header" ex4+    , testCase "Only reformats module header, open_bracket = same_line" ex4a     , testCase "Leaving pragmas in place" ex5+    , testCase "Leaving pragmas in place, open_bracket = same_line" ex5a     , testCase "Leaving pragmas in place variant" ex6+    , testCase "Leaving pragmas in place variant, open_bracket = same_line" ex6a     , testCase "Leaving comments in place" ex7+    , testCase "Leaving comments in place, open_bracket = same_line" ex7a     , testCase "Exports all" ex8+    , testCase "Exports all, open_bracket = same_line" ex8a     , testCase "Exports module" ex9+    , testCase "Exports module, open_bracket = same_line" ex9a     , testCase "Exports symbol" ex10+    , testCase "Exports symbol, open_bracket = same_line" ex10a     , testCase "Respects groups" ex11-    , testCase "'where' not repeated in case it isn't part of exports" ex12-    , testCase "Indents absent export list with 2 spaces" ex13+    , testCase "Respects groups, open_bracket = same_line" ex11a+    , testCase "'where' not repeated when not part of exports with always break_where" ex12+    , testCase "'where' not repeated when not part of exports with always break_where, open_bracket = same_line" ex12a+    , testCase "Indents absent export list with 2 spaces with always break_where" ex13+    , testCase "Indents absent export list with 2 spaces with always break_where, open_bracket = same_line" ex13a     , testCase "Indents with 2 spaces" ex14+    , testCase "Indents with 2 spaces, open_bracket = same_line" ex14a     , testCase "Group doc with 2 spaces" ex15+    , testCase "Group doc with 2 spaces, open_bracket = same_line" ex15a     , testCase "Does not sort" ex16     , testCase "Repects separate_lists" ex17+    , testCase "Repects separate_lists, open_bracket = same_line" ex17a+    , testCase "Indents absent export list with always break_where" ex18+    , testCase "Respects bundled patterns" ex19+    , testCase "Respects bundled patterns, open_bracket = same_line" ex19a+    , testCase "Inline no export list" ex20+    , testCase "Inline empty export list" ex21+    , testCase "Inline empty export list, open_bracket = same_line" ex21a+    , testCase "Inline single export" ex22+    , testCase "Inline single export, open_bracket = same_line" ex22a+    , testCase "Inline single line sorts" ex23+    , testCase "Inline single line sorts, open_bracket = same_line" ex23a+    , testCase "Inline breaks when too long" ex24+    , testCase "Inline breaks when too long, open_bracket = same_line" ex24a+    , testCase "Inline single line when no max cols" ex25+    , testCase "Inline single line when no max cols, open_bracket = same_line" ex25a+    , testCase "Inline breaks when comments present" ex26+    , testCase "Inline breaks when comments present, open_bracket = same_line" ex26a+    , testCase "Single no export list" ex27+    , testCase "Single no export list, open_bracket = same_line" ex27a+    , testCase "Single empty export list" ex28+    , testCase "Single empty export list, open_bracket = same_line" ex28a+    , testCase "Single one export" ex29+    , testCase "Single one export, open_bracket = same_line" ex29a+    , testCase "Single two exports" ex30+    , testCase "Single two exports, open_bracket = same_line" ex30a+    , testCase "Single one export with comment" ex31+    , testCase "Single one export with comment, open_bracket = same_line" ex31a     ]  -------------------------------------------------------------------------------- ex0 :: Assertion-ex0 = assertSnippet (step defaultConfig)-    [ "module Foo where"-    ]-    [ "module Foo"-    , "    where"-    ]+ex0 = assertSnippet (step Nothing defaultConfig) input input+  where+    input =+      [ "module Foo where"+      ] +ex0a :: Assertion+ex0a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine) input input+  where+    input =+      [ "module Foo where"+      ]+ ex1 :: Assertion-ex1 = assertSnippet (step defaultConfig)+ex1 = assertSnippet (step Nothing defaultConfig)     [ "module Foo () where"     ]     [ "module Foo"@@ -55,8 +105,17 @@     , "    ) where"     ] +ex1a :: Assertion+ex1a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo () where"+    ]+    [ "module Foo ("+    , "     "+    , "    ) where"+    ]+ ex2 :: Assertion-ex2 = assertSnippet (step defaultConfig)+ex2 = assertSnippet (step Nothing defaultConfig)     [ "module Foo (tests) where"     ]     [ "module Foo"@@ -64,8 +123,17 @@     , "    ) where"     ] +ex2a :: Assertion+ex2a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo (tests) where"+    ]+    [ "module Foo ("+    , "      tests"+    , "    ) where"+    ]+ ex3 :: Assertion-ex3 = assertSnippet (step defaultConfig)+ex3 = assertSnippet (step Nothing defaultConfig)     [ "module Foo (t1, t2, t3) where"     ]     [ "module Foo"@@ -75,8 +143,19 @@     , "    ) where"     ] +ex3a :: Assertion+ex3a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo (t1, t2, t3) where"+    ]+    [ "module Foo ("+    , "      t1"+    , "    , t2"+    , "    , t3"+    , "    ) where"+    ]+ ex4 :: Assertion-ex4 = assertSnippet (step defaultConfig)+ex4 = assertSnippet (step Nothing defaultConfig)     [ "module Foo ("     , "  t1,"     , "  t3,"@@ -100,8 +179,33 @@     , "foo = 1"     ] +ex4a :: Assertion+ex4a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo ("+    , "  t1,"+    , "  t3,"+    , "  t2"+    , ") where"+    , ""+    , ""+    , "-- | Docstring"+    , "foo :: Int"+    , "foo = 1"+    ]+    [ "module Foo ("+    , "      t1"+    , "    , t2"+    , "    , t3"+    , "    ) where"+    , ""+    , ""+    , "-- | Docstring"+    , "foo :: Int"+    , "foo = 1"+    ]+ ex5 :: Assertion-ex5 = assertSnippet (step defaultConfig)+ex5 = assertSnippet (step Nothing defaultConfig)     [ "{-# LANGUAGE DerivingVia #-}"     , "-- | This module docs"     , "module Foo ("@@ -119,8 +223,27 @@     , "    ) where"     ] +ex5a :: Assertion+ex5a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "{-# LANGUAGE DerivingVia #-}"+    , "-- | This module docs"+    , "module Foo ("+    , "  t1,"+    , "  t3,"+    , "  t2"+    , ") where"+    ]+    [ "{-# LANGUAGE DerivingVia #-}"+    , "-- | This module docs"+    , "module Foo ("+    , "      t1"+    , "    , t2"+    , "    , t3"+    , "    ) where"+    ]+ ex6 :: Assertion-ex6 = assertSnippet (step defaultConfig)+ex6 = assertSnippet (step Nothing defaultConfig)     [ "-- | This module docs"     , "{-# LANGUAGE DerivingVia #-}"     , "module Foo ("@@ -138,8 +261,27 @@     , "    ) where"     ] +ex6a :: Assertion+ex6a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "-- | This module docs"+    , "{-# LANGUAGE DerivingVia #-}"+    , "module Foo ("+    , "    t1,"+    , "    t3,"+    , "    t2"+    , ") where"+    ]+    [ "-- | This module docs"+    , "{-# LANGUAGE DerivingVia #-}"+    , "module Foo ("+    , "      t1"+    , "    , t2"+    , "    , t3"+    , "    ) where"+    ]+ ex7 :: Assertion-ex7 = assertSnippet (step defaultConfig)+ex7 = assertSnippet (step Nothing defaultConfig)     [ "module Foo -- Foo"     , "("     , " -- * t1 something"@@ -159,10 +301,30 @@     , "    ) where -- x"     , "-- y"     ]-+ex7a :: Assertion+ex7a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo -- Foo"+    , "("+    , " -- * t1 something"+    , "  t3,"+    , "  t1,"+    , " -- * t2 something"+    , "  t2"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo ( -- Foo"+    , "      -- * t1 something"+    , "      t1"+    , "    , t3"+    , "      -- * t2 something"+    , "    , t2"+    , "    ) where -- x"+    , "-- y"+    ]  ex8 :: Assertion-ex8 = assertSnippet (step defaultConfig)+ex8 = assertSnippet (step Nothing defaultConfig)     [ "module Foo ("     , " -- * t1 something"     , "  t3,"@@ -184,8 +346,31 @@     , "-- y"     ] +ex8a :: Assertion+ex8a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo ("+    , " -- * t1 something"+    , "  t3,"+    , "  A(..),"+    , " -- * t2 something"+    , "  t2,"+    , "  t1"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo ("+    , "      -- * t1 something"+    , "      A (..)"+    , "    , t3"+    , "      -- * t2 something"+    , "    , t1"+    , "    , t2"+    , "    ) where -- x"+    , "-- y"+    ]+ ex9 :: Assertion-ex9 = assertSnippet (step defaultConfig)+ex9 = assertSnippet (step Nothing defaultConfig)     [ "module Foo ("     , " -- * t1 something"     , "  module A,"@@ -205,8 +390,29 @@     , "-- y"     ] +ex9a :: Assertion+ex9a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo ("+    , " -- * t1 something"+    , "  module A,"+    , "  t3,"+    , " -- * t2 something"+    , "  t2"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo ("+    , "      -- * t1 something"+    , "      module A"+    , "    , t3"+    , "      -- * t2 something"+    , "    , t2"+    , "    ) where -- x"+    , "-- y"+    ]+ ex10 :: Assertion-ex10 = assertSnippet (step defaultConfig)+ex10 = assertSnippet (step Nothing defaultConfig)     [ "module Foo ("     , "  (<&>)"     , ") where -- x"@@ -218,8 +424,21 @@     , "-- y"     ] +ex10a :: Assertion+ex10a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo ("+    , "  (<&>)"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo ("+    , "      (<&>)"+    , "    ) where -- x"+    , "-- y"+    ]+ ex11 :: Assertion-ex11 = assertSnippet (step defaultConfig)+ex11 = assertSnippet (step Nothing defaultConfig)     [ "module Foo ("     , "  -- group 1"     , " g1_1,"@@ -239,8 +458,29 @@     , "    ) where"     ] +ex11a :: Assertion+ex11a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "module Foo ("+    , "  -- group 1"+    , " g1_1,"+    , " g1_0,"+    , "  -- group 2"+    , " g0_1,"+    , " g0_0"+    , ") where"+    ]+    [ "module Foo ("+    , "      -- group 1"+    , "      g1_0"+    , "    , g1_1"+    , "      -- group 2"+    , "    , g0_0"+    , "    , g0_1"+    , "    ) where"+    ]+ ex12 :: Assertion-ex12 = assertSnippet (step defaultConfig)+ex12 = assertSnippet (step Nothing defaultConfig {breakWhere = Always})     [ "module Foo"     , "  where"     , "-- hmm"@@ -249,17 +489,35 @@     , "    where"     , "-- hmm"     ]+ex12a :: Assertion+ex12a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Always} & openBracketSameLine)+    [ "module Foo"+    , "  where"+    , "-- hmm"+    ]+    [ "module Foo"+    , "    where"+    , "-- hmm"+    ]  ex13 :: Assertion-ex13 = assertSnippet (step defaultConfig {indent = 2})+ex13 = assertSnippet (step Nothing defaultConfig {breakWhere = Always, indent = 2})     [ "module Foo where"     ]     [ "module Foo"     , "  where"     ] +ex13a :: Assertion+ex13a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Always, indent = 2} & openBracketSameLine)+    [ "module Foo where"+    ]+    [ "module Foo"+    , "  where"+    ]+ ex14 :: Assertion-ex14 = assertSnippet (step defaultConfig {indent = 2})+ex14 = assertSnippet (step Nothing defaultConfig {indent = 2})     [ "module Foo"     , "  ( yes"     , "  , no"@@ -271,8 +529,21 @@     , "  ) where"     ] +ex14a :: Assertion+ex14a = assertSnippet (step Nothing $ defaultConfig {indent = 2} & openBracketSameLine)+    [ "module Foo"+    , "  ( yes"+    , "  , no"+    , "  ) where"+    ]+    [ "module Foo ("+    , "    no"+    , "  , yes"+    , "  ) where"+    ]+ ex15 :: Assertion-ex15 = assertSnippet (step defaultConfig {indent = 2})+ex15 = assertSnippet (step Nothing defaultConfig {indent = 2})     [ "module Foo -- Foo"     , "("     , " -- * t1 something"@@ -291,8 +562,28 @@     , "  ) where"     ] +ex15a :: Assertion+ex15a = assertSnippet (step Nothing $ defaultConfig {indent = 2} & openBracketSameLine)+    [ "module Foo -- Foo"+    , "("+    , " -- * t1 something"+    , "  t3,"+    , "  t1,"+    , " -- * t2 something"+    , "  t2"+    , ") where"+    ]+    [ "module Foo ( -- Foo"+    , "    -- * t1 something"+    , "    t1"+    , "  , t3"+    , "    -- * t2 something"+    , "  , t2"+    , "  ) where"+    ]+ ex16 :: Assertion-ex16 = assertSnippet (step defaultConfig {sort = False}) input input+ex16 = assertSnippet (step Nothing defaultConfig {sort = False}) input input   where     input =       [ "module Foo"@@ -302,7 +593,7 @@       ]  ex17 :: Assertion-ex17 = assertSnippet (step defaultConfig {separateLists = False})+ex17 = assertSnippet (step Nothing defaultConfig {separateLists = False})     [ "module Foo"     , "    ( Bar (..)"     , "    ) where"@@ -311,3 +602,288 @@     , "    ( Bar(..)"     , "    ) where"     ]++ex17a :: Assertion+ex17a = assertSnippet (step Nothing $ defaultConfig {separateLists = False} & openBracketSameLine)+    [ "module Foo"+    , "    ( Bar (..)"+    , "    ) where"+    ]+    [ "module Foo ("+    , "      Bar(..)"+    , "    ) where"+    ]++ex18 :: Assertion+ex18 = assertSnippet (step Nothing defaultConfig {breakWhere = Always})+    [ "module Foo where"+    ]+    [ "module Foo"+    , "    where"+    ]++ex19 :: Assertion+ex19 = assertSnippet (step Nothing defaultConfig)+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo (Bar (.., Baz)) where"+    ]+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo"+    , "    ( Bar (.., Baz)"+    , "    ) where"+    ]++ex19a :: Assertion+ex19a = assertSnippet (step Nothing $ defaultConfig & openBracketSameLine)+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo (Bar (.., Baz)) where"+    ]+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo ("+    , "      Bar (.., Baz)"+    , "    ) where"+    ]++ex20 :: Assertion+ex20 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "module Foo where"+    ]+    [ "module Foo where"+    ]++ex21 :: Assertion+ex21 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "module Foo () where"+    ]+    [ "module Foo () where"+    ]++ex21a :: Assertion+ex21a = assertSnippet (step (Just 80) $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "module Foo () where"+    ]+    [ "module Foo () where"+    ]++ex22 :: Assertion+ex22 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "module Foo"+    , "    ( main"+    , "    ) where"+    ]+    [ "module Foo (main) where"+    ]++ex22a :: Assertion+ex22a = assertSnippet (step (Just 80) $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "module Foo"+    , "    ( main"+    , "    ) where"+    ]+    [ "module Foo (main) where"+    ]++ex23 :: Assertion+ex23 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo"+    , "    ( Foo(MkFoo)"+    , "    , Bar (.., Baz)"+    , "    ) where"+    ]+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo (Bar (.., Baz), Foo (MkFoo)) where"+    ]++ex23a  :: Assertion+ex23a = assertSnippet (step (Just 80) $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo"+    , "    ( Foo(MkFoo)"+    , "    , Bar (.., Baz)"+    , "    ) where"+    ]+    [ "{-# LANGUAGE PatternSynonyms #-}"+    , "module Foo (Bar (.., Baz), Foo (MkFoo)) where"+    ]++ex24 :: Assertion+ex24 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]+    [ "module LongModuleName"+    , "    ( longExportName1"+    , "    , longExportName2"+    , "    , longExportName3"+    , "    , longExportName4"+    , "    ) where"+    ]++ex24a :: Assertion+ex24a = assertSnippet (step (Just 80) $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]+    [ "module LongModuleName ("+    , "      longExportName1"+    , "    , longExportName2"+    , "    , longExportName3"+    , "    , longExportName4"+    , "    ) where"+    ]++ex25 :: Assertion+ex25 = assertSnippet (step Nothing defaultConfig {breakWhere = Inline})+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]++ex25a :: Assertion+ex25a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]+    [ "module LongModuleName (longExportName1, longExportName2, longExportName3, longExportName4) where"+    ]++ex26 :: Assertion+ex26 = assertSnippet (step (Just 80) defaultConfig {breakWhere = Inline})+    [ "module Foo ("+    , " -- * t1 something"+    , "  module A,"+    , "  t3,"+    , " -- * t2 something"+    , "  t2"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo"+    , "    ( -- * t1 something"+    , "      module A"+    , "    , t3"+    , "      -- * t2 something"+    , "    , t2"+    , "    ) where -- x"+    , "-- y"+    ]++ex26a :: Assertion+ex26a = assertSnippet (step (Just 80) $ defaultConfig {breakWhere = Inline} & openBracketSameLine)+    [ "module Foo ("+    , " -- * t1 something"+    , "  module A,"+    , "  t3,"+    , " -- * t2 something"+    , "  t2"+    , ") where -- x"+    , "-- y"+    ]+    [ "module Foo ("+    , "      -- * t1 something"+    , "      module A"+    , "    , t3"+    , "      -- * t2 something"+    , "    , t2"+    , "    ) where -- x"+    , "-- y"+    ]++ex27 :: Assertion+ex27 = assertSnippet (step Nothing defaultConfig {breakWhere = Single})+    [ "module Foo where"+    ]+    [ "module Foo where"+    ]++ex27a :: Assertion+ex27a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single} & openBracketSameLine)+    [ "module Foo where"+    ]+    [ "module Foo where"+    ]++ex28 :: Assertion+ex28 = assertSnippet (step Nothing defaultConfig {breakWhere = Single})+    [ "module Foo () where"+    ]+    [ "module Foo () where"+    ]++ex28a :: Assertion+ex28a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single} & openBracketSameLine)+    [ "module Foo () where"+    ]+    [ "module Foo () where"+    ]++ex29 :: Assertion+ex29 = assertSnippet (step Nothing defaultConfig {breakWhere = Single})+    [ "module Foo"+    , "    ( main"+    , "    ) where"+    ]+    [ "module Foo (main) where"+    ]++ex29a :: Assertion+ex29a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single} & openBracketSameLine)+    [ "module Foo"+    , "    ( main"+    , "    ) where"+    ]+    [ "module Foo (main) where"+    ]++ex30 :: Assertion+ex30 = assertSnippet (step Nothing defaultConfig {breakWhere = Single})+    [ "module Foo"+    , "    ( bar"+    , "    , foo"+    , "    ) where"+    ]+    [ "module Foo"+    , "    ( bar"+    , "    , foo"+    , "    ) where"+    ]++ex30a :: Assertion+ex30a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single} & openBracketSameLine)+    [ "module Foo"+    , "    ( bar"+    , "    , foo"+    , "    ) where"+    ]+    [ "module Foo ("+    , "      bar"+    , "    , foo"+    , "    ) where"+    ]++ex31 :: Assertion+ex31 = assertSnippet (step Nothing defaultConfig {breakWhere = Single})+    [ "module Foo"+    , "    ( -- * Foo"+    , "      Foo"+    , "    ) where"+    ]+    [ "module Foo"+    , "    ( -- * Foo"+    , "      Foo"+    , "    ) where"+    ]++ex31a :: Assertion+ex31a = assertSnippet (step Nothing $ defaultConfig {breakWhere = Single} & openBracketSameLine)+    [ "module Foo"+    , "    ( -- * Foo"+    , "      Foo"+    , "    ) where"+    ]+    [ "module Foo ("+    , "      -- * Foo"+    , "      Foo"+    , "    ) where"+    ]++openBracketSameLine :: Config -> Config+openBracketSameLine cfg = cfg { openBracket = SameLine }

@@ -1,7 +1,9 @@ {-# LANGUAGE BlockArguments #-} {-# LANGUAGE TypeFamilies   #-} module Language.Haskell.Stylish.Tests.Util-    ( testStep+    ( dumpAst+    , dumpModule+    , testStep     , testStep'     , Snippet (..)     , testSnippet@@ -16,6 +18,8 @@ import           Control.Monad.Writer           (execWriter, tell) import           Data.List                      (intercalate) import           GHC.Exts                       (IsList (..))+import           GHC.Hs.Dump                    (showAstData, BlankSrcSpan(..))+import           Language.Haskell.Stylish.GHC   (baseDynFlags) import           System.Directory               (createDirectory,                                                  getCurrentDirectory,                                                  getTemporaryDirectory,@@ -26,12 +30,30 @@ import           System.Random                  (randomIO) import           Test.HUnit                     (Assertion, assertFailure,                                                  (@=?))-+import           Outputable                     (showSDoc)+import           Data.Data                      (Data(..))  -------------------------------------------------------------------------------- import           Language.Haskell.Stylish.Parse import           Language.Haskell.Stylish.Step+import           Language.Haskell.Stylish.Module (Module) +--------------------------------------------------------------------------------+-- | Takes a Haskell source as an argument and parse it into a Module.+-- Extract function selects element from that Module record and returns+-- its String representation.+--+-- This function should be used when trying to understand how particular+-- Haskell code will be represented by ghc-parser's AST+dumpAst :: Data a => (Module -> a) -> String -> String+dumpAst extract str =+  let Right(theModule) = parseModule [] Nothing str+      ast              = extract theModule+      sdoc             = showAstData BlankSrcSpan ast+  in  showSDoc baseDynFlags sdoc++dumpModule :: String -> String+dumpModule = dumpAst id  -------------------------------------------------------------------------------- testStep :: Step -> String -> String

@@ -22,6 +22,7 @@ import qualified Language.Haskell.Stylish.Step.TrailingWhitespace.Tests import qualified Language.Haskell.Stylish.Step.UnicodeSyntax.Tests import qualified Language.Haskell.Stylish.Tests+import qualified Language.Haskell.Stylish.Regressions   --------------------------------------------------------------------------------@@ -40,4 +41,5 @@     , Language.Haskell.Stylish.Step.TrailingWhitespace.Tests.tests     , Language.Haskell.Stylish.Step.UnicodeSyntax.Tests.tests     , Language.Haskell.Stylish.Tests.tests+    , Language.Haskell.Stylish.Regressions.tests     ]