brittany 0.9.0.1 → 0.10.0.0

raw patch · 25 files changed

+1465/−174 lines, 25 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +23/−0
• README.md +7/−12
• brittany.cabal +5/−1
• src-brittany/Main.hs +10/−44
• src-literatetests/10-tests.blt +326/−0
• src-literatetests/15-regressions.blt +65/−3
• src-literatetests/Main.hs +3/−0
• src-literatetests/tests-context-free.blt +264/−1
• src-unittests/TestUtils.hs +3/−0
• src/Language/Haskell/Brittany.hs +4/−0
• src/Language/Haskell/Brittany/Internal.hs +90/−41
• src/Language/Haskell/Brittany/Internal/Backend.hs +20/−1
• src/Language/Haskell/Brittany/Internal/Config.hs +62/−4
• src/Language/Haskell/Brittany/Internal/Config/Types.hs +23/−1
• src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +44/−0
• src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +2/−1
• src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +79/−39
• src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +145/−0
• src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +156/−0
• src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +62/−0
• src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +4/−3
• src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs +52/−15
• src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs +7/−5
• src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs +2/−2
• src/Language/Haskell/Brittany/Internal/Types.hs +7/−1

@@ -1,5 +1,28 @@ # Revision history for brittany +## 0.10.0.0 -- March 2018++* Implement module/exports/imports layouting (thanks to sniperrifle2004)+* Expose config paths/parsing functions (thanks to Alexey Raga)+* Bugfixes:+    - Fix layouting of `NOINLINE` pragma+    - Fix ticked type operator (e.g. `':-`) losing tick (#125)+    - Fix alignment issue with cases involving operators (#65)+    - Fix comments in tuples being dropped (#37)+    - Fix comment placements with let-in (#110)+* Layouting changes:+    - Align arguments only if it is the same function being called (#128)+    - Do not use single-line layout when infix operator expression contains+      comments (#111)+* New layouting config items:+    - `lconfig_importColumn`/`--import-col`: column for import items+    - `lconfig_importAsColumn`/`--import-as-col`: column for the "as" name of+      a module+    - `lconfig_reformatModulePreamble`: controls module/export/import layouting+      (default True)+    - `lconfig_allowSingleLineExportList`: permit one-line module header, e.g.+      `module Main (main)` (default False)+ ## 0.9.0.1  -- February 2018  * Support `TupleSections` (thanks to Matthew Piziak)

@@ -8,13 +8,12 @@ This project's goals roughly are to:  - Always retain the semantics of the source being transformed;-- Be idempotent (this also directly ensures that only valid haskell is-  produced);+- Be idempotent; - Support the full GHC-haskell syntax including syntactic extensions   (but excluding `-XCPP` which is too hard); - Retain newlines and comments unmodified; - Be clever about using the available horizontal space while not overflowing-  it if it cannot be avoided;+  the column maximum if it cannot be avoided; - Be clever about aligning things horizontally (this can be turned off   completely however); - Have linear complexity in the size of the input.@@ -27,8 +26,9 @@ But brittany is not finished yet, and there are some open issues that yet require fixing: -- **only type-signatures and function/value bindings** are processed;-  other module elements (data-decls, classes, instances, imports/exports etc.)+- **only the module header (imports/exports), type-signatures and+  function/value bindings** are processed;+  other module elements (data-decls, classes, instances, etc.)   are not transformed in any way; this extends to e.g. **bindings inside class   instance definitions** - they **won't be touched** (yet). - By using `ghc-exactprint` as the parser, brittany supports full GHC @@ -39,15 +39,12 @@   be detected and the user will get an error); there are other cases where   comments are moved slightly; there are also cases where comments result in   wonky newline insertion (although this should be a purely aesthetic issue.)-- ~~There is an **open performance issue on large inputs** (due to an-  accidentally quadratic sub-algorithm); noticable for inputs with >1k loc.~~-  (fixed in `0.8.0.3`)  ## Try without Installing  You can [paste haskell code over here](https://hexagoxel.de/brittany/) to test how it gets formatted by brittany. (Rg. privacy: the server does-log the size of the input, but _not_ the full requests.)+log the size of the input, but _not_ the full input/output of requests.)  # Other usage notes @@ -104,7 +101,7 @@   I have described a haskell setup that includes a shortcut to run brittany formatting. #### VSCode   [This extension](https://marketplace.visualstudio.com/items?itemName=MaxGabriel.brittany)-  connects commandline `brittany` to VSCode formatting API. Thanks to @MaxGarbriel.+  connects commandline `brittany` to VSCode formatting API. Thanks to @MaxGabriel. #### Via HIE   [haskell-ide-engine](https://github.com/haskell/haskell-ide-engine)   includes a `brittany` plugin that directly uses the brittany library.@@ -159,8 +156,6 @@ a good amount of high-level documentation at  [the documentation index](doc/implementation/index.md)--Note that most development happens on the `dev` branch of this repository!  # License 

@@ -1,5 +1,5 @@ name:                 brittany-version:              0.9.0.1+version:              0.10.0.0 synopsis:             Haskell source code formatter description: {   See <https://github.com/lspitzner/brittany/blob/master/README.md the README>.@@ -67,6 +67,9 @@     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@@ -108,6 +111,7 @@     , cmdargs >=0.10.14 && <0.11     , czipwith >=1.0.0.0 && <1.1     , ghc-boot-th >=8.0.1 && <8.3+    , filepath >=1.4.1.0 && <1.5     }   default-extensions: {     CPP

@@ -63,7 +63,8 @@   (PP.text "")   [ parDocW     [ "Reformats one or more haskell modules."-    , "Currently affects only type signatures and function bindings;"+    , "Currently affects only the module head (imports/exports), type"+    , "signatures and function bindings;"     , "everything else is left unmodified."     , "Based on ghc-exactprint, thus (theoretically) supporting all"     , "that ghc does."@@ -71,7 +72,7 @@   , parDoc $ "Example invocations:"   , PP.hang (PP.text "") 2 $ PP.vcat       [ PP.text "brittany"-      , PP.hang (PP.text "  ") 2 $ PP.text "read from stdin, output to stdout"+      , PP.nest 2 $ PP.text "read from stdin, output to stdout"       ]   , PP.hang (PP.text "") 2 $ PP.vcat       [ PP.text "brittany --indent=4 --write-mode=inplace *.hs"@@ -158,7 +159,7 @@     when printVersion $ do       do         putStrLn $ "brittany version " ++ showVersion version-        putStrLn $ "Copyright (C) 2016-2017 Lennart Spitzner"+        putStrLn $ "Copyright (C) 2016-2018 Lennart Spitzner"         putStrLn $ "There is NO WARRANTY, to the extent permitted by law."       System.Exit.exitSuccess     when printHelp $ do@@ -170,10 +171,14 @@                       Display -> repeat Nothing                       Inplace -> inputPaths -    config <- runMaybeT (readConfigs cmdlineConfig configPaths) >>= \case+    configsToLoad <- liftIO $ if null configPaths+                                then maybeToList <$> (Directory.getCurrentDirectory >>= findLocalConfigPath)+                                else pure configPaths++    config <- runMaybeT (readConfigsWithUserConfig cmdlineConfig configsToLoad) >>= \case       Nothing -> System.Exit.exitWith (System.Exit.ExitFailure 53)       Just x  -> return x-    when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $ do+    when (confUnpack $ _dconf_dump_config $ _conf_debug $ config) $       trace (showConfigYaml config) $ return ()      results <- zipWithM (coreIO putStrErrLn config suppressOutput) inputPaths outputPaths@@ -317,42 +322,3 @@          ]       then trace "----"       else id---readConfigs :: CConfig Option -> [System.IO.FilePath] -> MaybeT IO Config-readConfigs cmdlineConfig configPaths = do-  userBritPathSimple <- liftIO $ Directory.getAppUserDataDirectory "brittany"-  userBritPathXdg    <- liftIO-    $ Directory.getXdgDirectory Directory.XdgConfig "brittany"-  let userConfigPathSimple = userBritPathSimple FilePath.</> "config.yaml"-  let userConfigPathXdg    = userBritPathXdg FilePath.</> "config.yaml"-  let-    findLocalConfig :: MaybeT IO (Maybe (CConfig Option))-    findLocalConfig = do-      cwd <- liftIO $ Directory.getCurrentDirectory-      let dirParts = FilePath.splitDirectories cwd-      let searchDirs =-            [ FilePath.joinPath x | x <- reverse $ List.inits dirParts ]-      -- when cwd is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]-      mFilePath <- liftIO $ Directory.findFileWith Directory.doesFileExist-                                                   searchDirs-                                                   "brittany.yaml"-      case mFilePath of-        Nothing -> pure Nothing-        Just fp -> readConfig fp-  configsRead <- case configPaths of-    [] -> do-      localConfig      <- findLocalConfig-      userConfigSimple <- readConfig userConfigPathSimple-      userConfigXdg    <- readConfig userConfigPathXdg-      let userConfig = userConfigSimple <|> userConfigXdg-      when (Data.Maybe.isNothing userConfig) $ do-        liftIO $ Directory.createDirectoryIfMissing True userBritPathXdg-        writeDefaultConfig userConfigPathXdg-      -- rightmost has highest priority-      pure $ [userConfig, localConfig]-    paths -> readConfig `mapM` reverse paths-                   -- reverse to give highest priority to the first-  merged <--    pure $ Semigroup.mconcat $ catMaybes $ configsRead ++ [Just cmdlineConfig]-  return $ cZipWith fromOptionIdentity staticDefaultConfig merged

@@ -235,6 +235,17 @@   -> ColInfo   -> m () +#test forall context multiline with comments+{-# LANGUAGE RankNTypes #-}+addFlagStringParam+  :: forall f out+   . (Applicative f)+  => String -- ^ short flag chars, i.e. "v" for -v+  -> [String] -- ^ list of long names, i.e. ["verbose"]+  -> String -- ^ param name+  -> Flag String -- ^ properties+  -> CmdParser f out String+ #test language pragma issue {-# LANGUAGE ScopedTypeVariables #-} func :: forall (a :: *) b . a -> b@@ -287,6 +298,10 @@   {-# INLINE CONLIKE [1] f #-}   f = id +#test noinline pragma 1+{-# NOINLINE func #-}+func :: Int+ #test inline pragma 4 #pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2. func = f@@ -561,3 +576,314 @@        ]     ++ [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-things-comment+-- comment1++module Main+  ( Test(Test, a, b)+  , foo -- comment2+  ) -- comment3+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-simple+import           TestJustShortEnoughModuleNameLikeThisOne ( )+import           TestJustAbitToLongModuleNameLikeThisOneIs+                                                          ( )++#test long-module-name-as+import           TestJustShortEnoughModuleNameLikeThisOn as T+import           TestJustAbitToLongModuleNameLikeThisOneI+                                                         as T++#test long-module-name-hiding+import           TestJustShortEnoughModuleNameLike hiding ( )+import           TestJustAbitToLongModuleNameLikeTh+                                                   hiding ( )++#test long-module-name-simple-items+import           MoreThanSufficientlyLongModuleNameWithSome+                                                          ( items+                                                          , that+                                                          , will+                                                          , not+                                                          , fit+                                                          , inA+                                                          , compact+                                                          , layout+                                                          )++#test long-module-name-hiding-items+import           TestJustShortEnoughModuleNameLike hiding ( abc+                                                          , def+                                                          , ghci+                                                          , jklm+                                                          )+import           TestJustAbitToLongModuleNameLikeTh+                                                   hiding ( abc+                                                          , def+                                                          , ghci+                                                          , jklm+                                                          )++#test long-module-name-other+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 )

@@ -367,13 +367,22 @@   let     config' = staticDefaultConfig     config  = config'-      { _conf_layout  = (_conf_layout config') { _lconfig_indentAmount = coerce-                                                 tabSize-                                               }+      { _conf_layout  =+        (_conf_layout config') { _lconfig_indentAmount = coerce tabSize }       , _conf_forward = forwardOptionsSyntaxExtsEnabled       }   parsePrintModule config text +#test issue 37++foo =+  ( a+  , -- comment1+    b+    -- comment2+  , c+  )+ #test issue 38  {-# LANGUAGE TypeApplications #-}@@ -502,6 +511,21 @@   -> Proxy (str :: [*])   -> m (Tagged str String) +#test issue 65+widgetsDyn =+  [ [ vBox+        [ padTop Max outputLinesWidget+        , padRight Max wid1 <+> flowWidget  -- alignment here is strange/buggy+        , padBottom (Pad 5) help+        ]+    ]+  | wid1              <- promptDyn+  , (flowWidget, _)   <- flowResultD+  , outputLinesWidget <- outputLinesWidgetD+  , help              <- suggestionHelpBox+  , parser            <- cmdParserD+  ]+ #test issue 67 fmapuv :: U.Unbox a => (a -> b) -> U.Vector a -> V.Vector b fmapuv f xs = G.generate (G.length xs) (f . (xs G.!))@@ -514,6 +538,26 @@ {-# LANGUAGE TemplateHaskell #-} deriveFromJSON (unPrefix "assignPost") ''AssignmentPost +#test issue 110+main = -- a+  let --b+      x = 1 -- x+      y = 2 -- y+  in  do+        print x+        print y++#test issue 111+alternatives :: Parser (Maybe Text)+alternatives =+  alternativeOne   -- first try this one+    <|> alterantiveTwo   -- then this one+    <|> alternativeThree -- then this one+ where+  alternativeOne   = purer "one"+  alternativeTwo   = purer "two"+  alterantiveThree = purer "three"+ #test issue 116 {-# LANGUAGE BangPatterns #-} func = do@@ -525,3 +569,21 @@   Just ((k, _), q') | p k ->     let (kas, q'') = spanKey p q' in ((k, a) : kas, q'')   _ -> ([], q)++#test issue 125+a :: () ':- ()++#test issue 128+func = do+  createDirectoryIfMissing True path+  openFile fileName AppendMode++#test hspar-comments++alternatives :: Parser (Maybe Text)+alternatives = -- a+  ( -- b+      alternativeOne   -- c+  <|> alterantiveTwo   -- d+  <|> alternativeThree -- e+  ) -- f

@@ -169,11 +169,14 @@     , _lconfig_indentWhereSpecial        = coerce True     , _lconfig_indentListSpecial         = coerce True     , _lconfig_importColumn              = coerce (60 :: Int)+    , _lconfig_importAsColumn            = coerce (60 :: Int)     , _lconfig_altChooser                = coerce $ AltChooserBoundedSearch 3     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True     , _lconfig_hangingTypeSignature      = coerce False+    , _lconfig_reformatModulePreamble    = coerce True+    , _lconfig_allowSingleLineExportList = coerce True     }   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)     { _econf_omit_output_valid_check = coerce True

@@ -598,10 +598,274 @@       ]     ++ [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-simple+import TestJustShortEnoughModuleNameLikeThisOne ()+import TestJustAbitToLongModuleNameLikeThisOneIs ()+import MoreThanSufficientlyLongModuleNameWithSome+  (items, that, will, not, fit, inA, compact, layout)++#test long-module-name-as+import TestJustShortEnoughModuleNameLikeThisOn as T+import TestJustAbitToLongModuleNameLikeThisOneI as T++#test long-module-name-hiding+import TestJustShortEnoughModuleNameLike hiding ()+import TestJustAbitToLongModuleNameLikeTh hiding ()++#test long-module-name-simple-items+import MoreThanSufficientlyLongModuleNameWithSome+  (items, that, will, not, fit, inA, compact, layout)++#test long-module-name-hiding-items+import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm)++#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)++###############################################################################+###############################################################################+############################################################################### #group regression ############################################################################### ###############################################################################@@ -1133,4 +1397,3 @@ ##           ] ##  where ##   role = stringProperty "WM_WINDOW_ROLE"-

@@ -51,11 +51,14 @@     , _lconfig_indentWhereSpecial        = coerce True     , _lconfig_indentListSpecial         = coerce True     , _lconfig_importColumn              = coerce (60 :: Int)+    , _lconfig_importAsColumn            = coerce (60 :: Int)     , _lconfig_altChooser                = coerce $ AltChooserBoundedSearch 3     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True     , _lconfig_hangingTypeSignature      = coerce False+    , _lconfig_reformatModulePreamble    = coerce True+    , _lconfig_allowSingleLineExportList = coerce True     }   , _conf_errorHandling = (_conf_errorHandling staticDefaultConfig)     { _econf_ExactPrintFallback = coerce ExactPrintFallbackModeNever

@@ -4,6 +4,10 @@   ( parsePrintModule   , staticDefaultConfig   , forwardOptionsSyntaxExtsEnabled+  , userConfigPath+  , findLocalConfigPath+  , readConfigs+  , readConfigsWithUserConfig   , Config   , CConfig(..)   , CDebugConfig(..)

@@ -16,7 +16,7 @@ #include "prelude.inc"  import qualified Language.Haskell.GHC.ExactPrint as ExactPrint-import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types+import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers  import           Data.Data@@ -33,6 +33,7 @@  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@@ -132,7 +133,7 @@ -- can occur. pPrintModule   :: Config-  -> ExactPrint.Types.Anns+  -> ExactPrint.Anns   -> GHC.ParsedSource   -> ([BrittanyError], TextL.Text) pPrintModule conf anns parsedModule =@@ -160,7 +161,7 @@   in     tracer $ (errs, Text.Builder.toLazyText out)   -- unless () $ do-  --   +  --   --   debugStrings `forM_` \s ->   --     trace s $ return () @@ -168,7 +169,7 @@ -- if it does not. pPrintModuleAndCheck   :: Config-  -> ExactPrint.Types.Anns+  -> ExactPrint.Anns   -> GHC.ParsedSource   -> IO ([BrittanyError], TextL.Text) pPrintModuleAndCheck conf anns parsedModule = do@@ -248,33 +249,11 @@ --         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+      Map.findWithDefault Map.empty (ExactPrint.mkAnnKey decl) annMap      traceIfDumpConf "bridoc annotations filtered/transformed"                     _dconf_dump_annotations@@ -287,26 +266,26 @@       ppDecl decl   let finalComments = filter         ( fst .> \case-          ExactPrint.Types.AnnComment{} -> True+          ExactPrint.AnnComment{} -> True           _                             -> False         )         post   post `forM_` \case-    (ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do+    (ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do       ppmMoveToExactLoc l       mTell $ Text.Builder.fromString cmStr-    (ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->+    (ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->       let-        folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of-          ExactPrint.Types.AnnComment cm-            | GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm-            -> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span-               , y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span+        folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of+          ExactPrint.AnnComment cm+            | GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm+            -> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span+               , x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span                )-          _ -> (acc + x, y)-        (cmX, cmY) = foldl' folder (0, 0) finalComments+          _ -> (acc + y, x)+        (cmY, cmX) = foldl' folder (0, 0) finalComments       in-        ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)+        ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)     _ -> return ()  withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()@@ -341,6 +320,76 @@     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.KeywordId, ExactPrint.DeltaPos)]+ppPreamble lmod@(L loc m@(HsModule _ _ _ _ _ _)) = do+  filteredAnns <- mAsk <&> \annMap ->+    Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap+    -- Since ghc-exactprint adds annotations following (implicit)+    -- modules to both HsModule and the elements in the module+    -- this can cause duplication of comments. So strip+    -- attached annotations that come after the module's where+    -- from the module node+  config <- mAsk+  let shouldReformatPreamble =+        config & _conf_layout & _lconfig_reformatModulePreamble & confUnpack++  let+    (filteredAnns', post) =+      case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of+        Nothing -> (filteredAnns, [])+        Just mAnn ->+          let+            modAnnsDp = ExactPrint.annsDP mAnn+            isWhere (ExactPrint.G AnnWhere) = True+            isWhere _                       = False+            isEof (ExactPrint.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+            findInitialCommentSize = \case+              ((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)) : rest) ->+                let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm+                in  y+                    + GHC.srcSpanEndLine span+                    - GHC.srcSpanStartLine span+                    + findInitialCommentSize rest+              _ -> 0+            initialCommentSize  = findInitialCommentSize pre+            fixAbsoluteModuleDP = \case+              (g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->+                (g, ExactPrint.DP (y - initialCommentSize, x))+              x -> x+            pre' = if shouldReformatPreamble+              then map fixAbsoluteModuleDP pre+              else pre+            mAnn' = mAnn { ExactPrint.annsDP = pre' }+            filteredAnns'' =+              Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns+          in+            (filteredAnns'', post')+  traceIfDumpConf "bridoc annotations filtered/transformed"+                  _dconf_dump_annotations+    $ annsDoc filteredAnns'++  if shouldReformatPreamble+    then MultiRWSS.withoutMultiReader $ do+      MultiRWSS.mPutRawR $ config :+: filteredAnns' :+: HNil+      withTransformedAnns lmod $ do+        briDoc <- briDocMToPPM $ layoutModule lmod+        layoutBriDoc briDoc+    else+      let emptyModule = L loc m { hsmodDecls = [] }+      in  MultiRWSS.withMultiReader filteredAnns' $ processDefault emptyModule+  return post+ _sigHead :: Sig RdrName -> String _sigHead = \case   TypeSig names _ ->@@ -391,7 +440,7 @@     -- simpl <- mGet <&> transformToSimple     -- return simpl -  anns :: ExactPrint.Types.Anns <- mAsk+  anns :: ExactPrint.Anns <- mAsk    let state = LayoutState         { _lstate_baseYs           = [0]

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

@@ -9,6 +9,10 @@   , staticDefaultConfig   , forwardOptionsSyntaxExtsEnabled   , readConfig+  , userConfigPath+  , findLocalConfigPath+  , readConfigs+  , readConfigsWithUserConfig   , writeDefaultConfig   , showConfigYaml   )@@ -22,8 +26,10 @@ import           Language.Haskell.Brittany.Internal.LayouterBasics  import qualified Data.Yaml+import           Data.CZipWith  import           UI.Butcher.Monadic+import Data.Monoid ((<>))  import qualified System.Console.CmdArgs.Explicit as CmdArgs @@ -33,7 +39,8 @@  import           Data.Coerce ( Coercible, coerce ) -+import qualified System.Directory as Directory+import qualified System.FilePath.Posix as FilePath  staticDefaultConfig :: Config staticDefaultConfig = Config@@ -58,12 +65,15 @@     , _lconfig_indentAmount              = coerce (2 :: Int)     , _lconfig_indentWhereSpecial        = coerce True     , _lconfig_indentListSpecial         = coerce True-    , _lconfig_importColumn              = coerce (60 :: Int)+    , _lconfig_importColumn              = coerce (50 :: Int)+    , _lconfig_importAsColumn            = coerce (50 :: Int)     , _lconfig_altChooser                = coerce (AltChooserBoundedSearch 3)     , _lconfig_columnAlignMode           = coerce (ColumnAlignModeMajority 0.7)     , _lconfig_alignmentLimit            = coerce (30 :: Int)     , _lconfig_alignmentBreakOnMultiline = coerce True     , _lconfig_hangingTypeSignature      = coerce False+    , _lconfig_reformatModulePreamble    = coerce True+    , _lconfig_allowSingleLineExportList = coerce False     }   , _conf_errorHandling = ErrorHandlingConfig     { _econf_produceOutputOnErrors   = coerce False@@ -104,6 +114,7 @@   ind                <- addFlagReadParams "" ["indent"] "AMOUNT" (flagHelpStr "spaces per indentation level")   cols               <- addFlagReadParams "" ["columns"] "AMOUNT" (flagHelpStr "target max columns (80 is an old default for this)")   importCol          <- addFlagReadParams "" ["import-col"] "N" (flagHelpStr "column to align import lists at")+  importAsCol        <- addFlagReadParams "" ["import-as-col"] "N" (flagHelpStr "column to qualified-as module names at")    dumpConfig         <- addSimpleBoolFlag "" ["dump-config"] (flagHelp $ parDoc "dump the programs full config (merged commandline + file + defaults)")   dumpAnnotations    <- addSimpleBoolFlag "" ["dump-annotations"] (flagHelp $ parDoc "dump the full annotations returned by ghc-exactprint")@@ -153,11 +164,14 @@       , _lconfig_indentWhereSpecial        = mempty -- falseToNothing _       , _lconfig_indentListSpecial         = mempty -- falseToNothing _       , _lconfig_importColumn              = optionConcat importCol+      , _lconfig_importAsColumn            = optionConcat importAsCol       , _lconfig_altChooser                = mempty       , _lconfig_columnAlignMode           = mempty       , _lconfig_alignmentLimit            = mempty       , _lconfig_alignmentBreakOnMultiline = mempty       , _lconfig_hangingTypeSignature      = mempty+      , _lconfig_reformatModulePreamble    = mempty+      , _lconfig_allowSingleLineExportList = mempty       }     , _conf_errorHandling = ErrorHandlingConfig       { _econf_produceOutputOnErrors   = wrapLast $ falseToNothing outputOnErrors@@ -189,10 +203,10 @@ --     <*> switch (long "barb") --     <*> flag 3 5 (long "barc") --   )--- +-- -- configParserInfo :: ParserInfo Config -- configParserInfo = ParserInfo---   { infoParser      = configParser +--   { infoParser      = configParser --   , infoFullDesc    = True --   , infoProgDesc    = return $ PP.text "a haskell code formatting utility based on ghc-exactprint" --   , infoHeader      = return $ PP.text "brittany"@@ -226,6 +240,50 @@         Right x -> return x       return $ Just fileConf     else return $ Nothing++-- | Looks for a user-global config file and return its path.+-- If there is no global config in a system, one will be created.+userConfigPath :: IO System.IO.FilePath+userConfigPath = do+  userBritPathSimple <- Directory.getAppUserDataDirectory "brittany"+  userBritPathXdg    <- Directory.getXdgDirectory Directory.XdgConfig "brittany"+  let searchDirs = [userBritPathSimple, userBritPathXdg]+  globalConfig <- Directory.findFileWith Directory.doesFileExist searchDirs "config.yaml"+  maybe (writeUserConfig userBritPathXdg) pure globalConfig+  where+    writeUserConfig dir = do+      let createConfPath = dir FilePath.</> "config.yaml"+      liftIO $ Directory.createDirectoryIfMissing True dir+      writeDefaultConfig $ createConfPath+      pure createConfPath++-- | Searches for a local (per-project) brittany config starting from a given directory+findLocalConfigPath :: System.IO.FilePath -> IO (Maybe System.IO.FilePath)+findLocalConfigPath dir = do+  let dirParts = FilePath.splitDirectories dir+  -- when provided dir is "a/b/c", searchDirs is ["a/b/c", "a/b", "a", "/"]+  let searchDirs = FilePath.joinPath <$> reverse (List.inits dirParts)+  Directory.findFileWith Directory.doesFileExist searchDirs "brittany.yaml"++-- | Reads specified configs.+readConfigs+  :: CConfig Option        -- ^ Explicit options, take highest priority+  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first+  -> MaybeT IO Config+readConfigs cmdlineConfig configPaths = do+  configs <- readConfig `mapM` configPaths+  let merged = Semigroup.mconcat $ reverse (cmdlineConfig:catMaybes configs)+  return $ cZipWith fromOptionIdentity staticDefaultConfig merged++-- | Reads provided configs+-- but also applies the user default configuration (with lowest priority)+readConfigsWithUserConfig+  :: CConfig Option        -- ^ Explicit options, take highest priority+  -> [System.IO.FilePath]  -- ^ List of config files to load and merge, highest priority first+  -> MaybeT IO Config+readConfigsWithUserConfig cmdlineConfig configPaths = do+  defaultPath <- liftIO $ userConfigPath+  readConfigs cmdlineConfig (configPaths ++ [defaultPath])  writeDefaultConfig :: MonadIO m => System.IO.FilePath -> m () writeDefaultConfig path =

@@ -53,7 +53,14 @@   , _lconfig_indentListSpecial  :: f (Last Bool) -- use some special indentation for ","                                                  -- when creating zero-indentation                                                  -- multi-line list literals.-  , _lconfig_importColumn :: f (Last Int)+  , _lconfig_importColumn    :: f (Last Int)+    -- ^ for import statement layouting, column at which to align the+    -- elements to be imported from a module.+    -- It is expected that importAsColumn >= importCol.+  , _lconfig_importAsColumn  :: f (Last Int)+    -- ^ for import statement layouting, column at which put the module's+    -- "as" name (which also affects the positioning of the "as" keyword).+    -- It is expected that importAsColumn >= importCol.   , _lconfig_altChooser      :: f (Last AltChooser)   , _lconfig_columnAlignMode :: f (Last ColumnAlignMode)   , _lconfig_alignmentLimit  :: f (Last Int)@@ -84,6 +91,21 @@     --   -> SomeLongStuff     -- As usual for hanging indentation, the result will be     -- context-sensitive (in the function name).+  , _lconfig_reformatModulePreamble :: f (Last Bool)+    -- whether the module preamble/header (module keyword, name, export list,+    -- import statements) are reformatted. If false, only the elements of the+    -- module (everything past the "where") are reformatted.+  , _lconfig_allowSingleLineExportList :: f (Last Bool)+    -- if true, and it fits in a single line, and there are no comments in the+    -- export list, the following layout will be used:+    -- > module MyModule (abc, def) where+    -- > [stuff]+    -- otherwise, the multi-line version is used:+    -- > module MyModule+    -- >   ( abc+    -- >   , def+    -- >   )+    -- > where   }   deriving (Generic) 

@@ -4,6 +4,7 @@   , lrdrNameToText   , lrdrNameToTextAnn   , lrdrNameToTextAnnTypeEqualityIsSpecial+  , lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick   , askIndent   , extractAllComments   , filterAnns@@ -16,6 +17,7 @@   , docSeq   , docPar   , docNodeAnnKW+  , docNodeMoveToKWDP   , docWrapNode   , docWrapNodePrior   , docWrapNodeRest@@ -29,6 +31,7 @@   , docAnnotationPrior   , docAnnotationKW   , docAnnotationRest+  , docMoveToKWDP   , docNonBottomSpacing   , docSetParSpacing   , docForceParSpacing@@ -42,6 +45,7 @@   , appSep   , docCommaSep   , docParenLSep+  , docParenR   , docTick   , spacifyDocs   , briDocMToPPM@@ -216,6 +220,27 @@     then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh     else x +-- | Same as lrdrNameToTextAnnTypeEqualityIsSpecial, but also inspects+-- the annotations for a (parent) node for a tick to be added to the+-- literal.+-- Excessively long name to reflect on us having to work around such+-- excessively obscure special cases in the exactprint API.+lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick+  :: ( Data ast+     , MonadMultiReader Config m+     , MonadMultiReader (Map AnnKey Annotation) m+     )+  => Located ast+  -> Located RdrName+  -> m Text+lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick ast1 ast2 = do+  hasQuote <- hasAnnKeyword ast1 AnnSimpleQuote+  x        <- lrdrNameToTextAnn ast2+  let lit = if x == Text.pack "Data.Type.Equality~"+        then Text.pack "~" -- rraaaahhh special casing rraaahhhhhh+        else x+  return $ if hasQuote then Text.cons '\'' lit else lit+ askIndent :: (MonadMultiReader Config m) => m Int askIndent = confUnpack . _lconfig_indentAmount . _conf_layout <$> mAsk @@ -440,6 +465,13 @@   -> ToBriDocM BriDocNumbered docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm +docMoveToKWDP+  :: AnnKey+  -> AnnKeywordId+  -> ToBriDocM BriDocNumbered+  -> ToBriDocM BriDocNumbered+docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm+ docAnnotationRest   :: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm@@ -465,6 +497,9 @@ docParenLSep :: ToBriDocM BriDocNumbered docParenLSep = appSep $ docLit $ Text.pack "(" +docParenR :: ToBriDocM BriDocNumbered+docParenR = docLit $ Text.pack ")"+ docTick :: ToBriDocM BriDocNumbered docTick = docLit $ Text.pack "'" @@ -476,6 +511,15 @@   -> ToBriDocM BriDocNumbered docNodeAnnKW ast kw bdm =   docAnnotationKW (ExactPrint.Types.mkAnnKey ast) kw bdm++docNodeMoveToKWDP+  :: Data.Data.Data ast+  => Located ast+  -> AnnKeywordId+  -> ToBriDocM BriDocNumbered+  -> ToBriDocM BriDocNumbered+docNodeMoveToKWDP ast kw bdm =+  docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm  class DocWrapable a where   docWrapNode :: ( Data.Data.Data ast)

@@ -94,7 +94,8 @@             NoInline        -> "NOINLINE "             EmptyInlineSpec -> "" -- i have no idea if this is correct.       let phaseStr = case phaseAct of-            NeverActive      -> "[] "+            NeverActive      -> "" -- not [] - for NOINLINE NeverActive is+                                   -- in fact the default             AlwaysActive     -> ""             ActiveBefore _ i -> "[~" ++ show i ++ "] "             ActiveAfter  _ i -> "[" ++ show i ++ "] "

@@ -117,12 +117,16 @@             (L _ (HsApp l r)) -> gather (r:list) l             x -> (x, list)       let (headE, paramEs) = gather [exp2] exp1+      let colsOrSequence = case headE of+            L _ (HsVar (L _ (Unqual occname))) ->+              docCols (ColApp $ Text.pack $ occNameString occname)+            _ -> docSeq       headDoc <- docSharedWrapper layoutExpr headE       paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs       docAltFilter         [ -- foo x y           ( True-          , docCols ColApp+          , colsOrSequence           $ appSep (docForceSingleline headDoc)           : spacifyDocs (docForceSingleline <$> paramDocs)           )@@ -233,24 +237,27 @@                                               ]       opLastDoc <- docSharedWrapper layoutExpr expOp       expLastDoc <- docSharedWrapper layoutExpr expRight+      hasComments <- hasAnyCommentsBelow lexpr       let allowPar = case (expOp, expRight) of             (L _ (HsVar (L _ (Unqual occname))), _)               | occNameString occname == "$" -> True             (_, L _ (HsApp _ (L _ HsVar{}))) -> False             _ -> True-      docAlt-        [ docSeq-          [ appSep $ docForceSingleline leftOperandDoc+      docAltFilter+        [ ( not hasComments           , docSeq-          $ (appListDocs <&> \(od, ed) -> docSeq-              [ appSep $ docForceSingleline od-              , appSep $ docForceSingleline ed-              ]-            )-          , appSep $ docForceSingleline opLastDoc-          , (if allowPar then docForceParSpacing else docForceSingleline)-              expLastDoc-          ]+            [ appSep $ docForceSingleline leftOperandDoc+            , docSeq+            $ (appListDocs <&> \(od, ed) -> docSeq+                [ appSep $ docForceSingleline od+                , appSep $ docForceSingleline ed+                ]+              )+            , appSep $ docForceSingleline opLastDoc+            , (if allowPar then docForceParSpacing else docForceSingleline)+                expLastDoc+            ]+          )         -- this case rather leads to some unfortunate layouting than to anything         -- useful; disabling for now. (it interfers with cols stuff.)         -- , docSetBaseY@@ -260,12 +267,14 @@         -- -    $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])         --       ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]         --     )-        , docPar+        , (otherwise+          , docPar             leftOperandDoc             ( docLines             $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed])               ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]]             )+          )         ]     OpApp expLeft expOp _ expRight -> do       expDocLeft  <- docSharedWrapper layoutExpr expLeft@@ -318,7 +327,7 @@                , opDoc                ]     HsPar innerExp -> do-      innerExpDoc <- docSharedWrapper layoutExpr innerExp+      innerExpDoc <- docSharedWrapper (docWrapNode lexpr . layoutExpr) innerExp       docAlt         [ docSeq           [ docLit $ Text.pack "("@@ -342,8 +351,12 @@       rightDoc <- docSharedWrapper layoutExpr right       docSeq [opDoc, docSeparator, rightDoc]     ExplicitTuple args boxity -> do-      let argExprs = fmap (\case (L _ (Present e)) -> Just e; (L _ (Missing PlaceHolder)) -> Nothing) args-      argDocs <- docSharedWrapper (maybe docEmpty layoutExpr) `mapM` argExprs+      let argExprs = args <&> \arg -> case arg of+            (L _ (Present e)) -> (arg, Just e);+            (L _ (Missing PlaceHolder)) -> (arg, Nothing)+      argDocs <- forM argExprs+        $ docSharedWrapper+        $ \(arg, exprM) -> docWrapNode arg $ maybe docEmpty layoutExpr exprM       hasComments <- hasAnyCommentsBelow lexpr       let (openLit, closeLit) = case boxity of             Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")")@@ -530,22 +543,26 @@         (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)     HsLet binds exp1 -> do       expDoc1 <- docSharedWrapper layoutExpr exp1-      mBindDocs <- layoutLocalBinds binds+      -- We jump through some ugly hoops here to ensure proper sharing.+      mBindDocs <- mapM (fmap (fmap return) . docWrapNodeRest lexpr . return)+               =<< layoutLocalBinds binds       let         ifIndentLeftElse :: a -> a -> a         ifIndentLeftElse x y =           if indentPolicy == IndentPolicyLeft then x else y-      -- this `docSetIndentLevel` might seem out of place, but is here due to-      -- ghc-exactprint's DP handling of "let" in particular.+      -- this `docSetBaseAndIndent` might seem out of place (especially the+      -- Indent part; setBase is necessary due to the use of docLines below),+      -- but is here due to ghc-exactprint's DP handling of "let" in+      -- particular.       -- Just pushing another indentation level is a straightforward approach       -- to making brittany idempotent, even though the result is non-optimal       -- if "let" is moved horizontally as part of the transformation, as the       -- comments before the first let item are moved horizontally with it.-      docSetIndentLevel $ case mBindDocs of+      docSetBaseAndIndent $ case mBindDocs of         Just [bindDoc] -> docAlt           [ docSeq               [ appSep $ docLit $ Text.pack "let"-              , appSep $ docForceSingleline $ return bindDoc+              , appSep $ docForceSingleline $ bindDoc               , appSep $ docLit $ Text.pack "in"               , docForceSingleline $ expDoc1               ]@@ -554,12 +571,12 @@                   [ docSeq                       [ appSep $ docLit $ Text.pack "let"                       , ifIndentLeftElse docForceSingleline docSetBaseAndIndent-                      $ return bindDoc+                      $ bindDoc                       ]                   , docAddBaseY BrIndentRegular                   $ docPar                     (docLit $ Text.pack "let")-                    (docSetBaseAndIndent $ return bindDoc)+                    (docSetBaseAndIndent $ bindDoc)                   ]               , docAlt                   [ docSeq@@ -592,7 +609,7 @@               [ docAddBaseY BrIndentRegular               $ docPar                 (docLit $ Text.pack "let")-                (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+                (docSetBaseAndIndent $ docLines $ bindDocs)               , docSeq                 [ docLit $ Text.pack "in "                 , docAddBaseY BrIndentRegular $ expDoc1@@ -603,7 +620,7 @@             , docLines               [ docSeq                 [ appSep $ docLit $ Text.pack "let"-                , docSetBaseAndIndent $ docLines $ return <$> bindDocs+                , docSetBaseAndIndent $ docLines $ bindDocs                 ]               , docSeq                 [ appSep $ docLit $ Text.pack "in "@@ -616,7 +633,7 @@               [ docAddBaseY BrIndentRegular               $ docPar                 (docLit $ Text.pack "let")-                (docSetBaseAndIndent $ docLines $ return <$> bindDocs)+                (docSetBaseAndIndent $ docLines $ bindDocs)               , docAddBaseY BrIndentRegular               $ docPar                 (docLit $ Text.pack "in")@@ -733,6 +750,8 @@         , docLit $ Text.pack "}"         ]     RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do+      -- TODO: the layouter for RecordUpd is slightly more clever. Should+      -- probably copy the approach from there.       let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname       ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do         fExpDoc <- if pun@@ -852,7 +871,7 @@             Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc)             Ambiguous   n _ -> (lfield, lrdrNameToText n, rFExpDoc)       docAltFilter-        -- singleline+        -- container { fieldA = blub, fieldB = blub }         [ ( True           , docSeq             [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc@@ -870,7 +889,10 @@             , docLit $ Text.pack "}"             ]           )-        -- wild-indentation block+        -- hanging single-line fields+        -- container { fieldA = blub+        --           , fieldB = blub+        --           }         , ( indentPolicy /= IndentPolicyLeft           , docSeq             [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc@@ -881,7 +903,7 @@                   , case rF1e of                       Just x -> docWrapNodeRest rF1f $ docSeq                                       [ appSep $ docLit $ Text.pack "="-                                      , docForceSingleline $ x+                                      , docForceSingleline x                                       ]                       Nothing -> docEmpty                   ]@@ -901,36 +923,54 @@                 in [line1] ++ lineR ++ [lineN]             ]           )-        -- strict indentation block+          -- non-hanging with expressions placed to the right of the names+          -- container+          -- { fieldA = blub+          -- , fieldB = potentially+          --     multiline+          -- }         , ( True           , docSetParSpacing           $ docAddBaseY BrIndentRegular           $ docPar               (docNodeAnnKW lexpr Nothing $ rExprDoc)               (docNonBottomSpacing $ docLines $ let+                expressionWrapper = if indentPolicy == IndentPolicyLeft+                  then docForceParSpacing+                  else docSetBaseY                 line1 = docCols ColRecUpdate                   [ appSep $ docLit $ Text.pack "{"                   , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n                   , docWrapNodeRest rF1f $ case rF1e of-                      Just x -> docSeq [ appSep $ docLit $ Text.pack "="-                                      , docAddBaseY BrIndentRegular $ x-                                      ]+                      Just x -> docAlt+                        [ docSeq [ appSep $ docLit $ Text.pack "="+                                 , expressionWrapper x+                                 ]+                        , docAddBaseY BrIndentRegular+                        $ docPar (docLit $ Text.pack "=") x+                        ]                       Nothing -> docEmpty                   ]-                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate+                lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield+                  $ docCols ColRecUpdate                   [ docCommaSep                   , appSep $ docLit $ fText                   , case fDoc of-                      Just x ->  docSeq [ appSep $ docLit $ Text.pack "="-                                        , docAddBaseY BrIndentRegular x-                                        ]+                      Just x -> docAlt+                        [ docSeq [ appSep $ docLit $ Text.pack "="+                                 , expressionWrapper x+                                 ]+                        , docAddBaseY BrIndentRegular+                        $ docPar (docLit $ Text.pack "=") x+                        ]                       Nothing -> docEmpty                   ]                 lineN = docSeq                   [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty                   , docLit $ Text.pack "}"                   ]-                in [line1] ++ lineR ++ [lineN])+                in [line1] ++ lineR ++ [lineN]+              )           )         ] #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */

@@ -0,0 +1,145 @@+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+        , docAddBaseY BrIndentRegular+        $ docPar 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 :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered+layoutLLIEs enableSingleline 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 && enableSingleline+        , docSeq+        $  [docLit (Text.pack "(")]+        ++ (docForceSingleline <$> ieDs)+        ++ [docParenR]+        )+      , ( otherwise+        , docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH])+        $  docLines+        $  ieDsT+        ++ [docParenR]+        )+      ]

@@ -0,0 +1,156 @@+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+    importAsCol <- mAsk <&> _conf_layout .> _lconfig_importAsColumn .> 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 "+      hidingParenCost  = 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+      hidDocCol = if hiding then importCol - hidingParenCost else importCol - 2+      hidDocColDiff = importCol - 2 - hidDocCol+      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 True llies]+          else do+            ieDs <- layoutAnnAndSepLLIEs llies+            docWrapNodeRest llies+              $ docEnsureIndent (BrIndentSpecial hidDocCol)+              $ case ieDs of+                -- ..[hiding].( )+                [] -> if hasComments+                  then docPar+                    (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])+                    (docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR)+                  else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]+                  -- ..[hiding].( b )+                [ieD] -> docAltFilter+                  [ ( not hasComments+                    , docSeq+                      [ hidDoc+                      , docParenLSep+                      , docForceSingleline $ ieD+                      , docSeparator+                      , docParenR+                      ]+                    )+                  , ( otherwise+                    , docPar+                      (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD])+                      (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR)+                    )+                  ]+                  -- ..[hiding].( b+                  --            , b'+                  --            )+                (ieD:ieDs') ->+                  docPar+                    (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])+                    (  docEnsureIndent (BrIndentSpecial hidDocColDiff)+                    $  docLines+                    $  ieDs'+                    ++ [docParenR]+                    )+      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, bindingsD]+        , docAddBaseY BrIndentRegular $+            docPar (docSeq [importHead, asDoc]) bindingsD+        ]+    else+      case masT of+        Just n -> if enoughRoom+          then docLines+                 [ docSeq [importHead, asDoc], bindingsD]+          else docLines [importHead, asDoc, bindingsD]+         where+          enoughRoom = nameCost < importAsCol - asCost+          asDoc =+            docEnsureIndent (BrIndentSpecial (importAsCol - asCost))+              $ makeAsDoc n+        Nothing -> if enoughRoom+          then docSeq [importHead, bindingsD]+          else docLines [importHead, bindingsD]+          where enoughRoom = nameCost < importCol - hidingParenCost+  _ -> docEmpty

@@ -0,0 +1,62 @@+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+    allowSingleLineExportList <- mAsk+      <&> _conf_layout+      .>  _lconfig_allowSingleLineExportList+      .>  confUnpack+    docLines+      $ docSeq+          [ docNodeAnnKW lmod Nothing docEmpty+             -- A pseudo node that serves merely to force documentation+             -- before the node+          , docNodeMoveToKWDP lmod AnnModule $ docAltFilter+            [ (,) allowSingleLineExportList $ docForceSingleline $ docSeq+                   [ appSep $ docLit $ Text.pack "module"+                   , appSep $ docLit tn+                   , docWrapNode lmod $ appSep $ case les of+                     Nothing -> docEmpty+                     Just x  -> layoutLLIEs True x+                   , docLit $ Text.pack "where"+                   ]+            , (,) otherwise $ docLines+                   [ docAddBaseY BrIndentRegular $ docPar+                     (docSeq [appSep $ docLit $ Text.pack "module", docLit tn]+                     )+                     (docWrapNode lmod $ case les of+                       Nothing -> docEmpty+                       Just x  -> layoutLLIEs False x+                     )+                   , docLit $ Text.pack "where"+                   ]+            ]+          ]+      : map layoutImport imports

@@ -317,7 +317,7 @@   HsAppsTy [L _ (HsAppPrefix typ1)] -> do     typeDoc1 <- docSharedWrapper layoutType typ1     typeDoc1-  HsAppsTy [_lname@(L _ (HsAppInfix name))] -> do+  HsAppsTy [lname@(L _ (HsAppInfix name))] -> do     -- this redirection is somewhat hacky, but whatever.     -- TODO: a general problem when doing deep inspections on     --       the type (and this is not the only instance)@@ -326,7 +326,7 @@     --       circumstances exactly important annotations (comments)     --       would be assigned to such constructors.     typeDoc1 <- -- docSharedWrapper layoutType $ (L l $ HsTyVar name)-      lrdrNameToTextAnnTypeEqualityIsSpecial name+      lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lname name     docLit typeDoc1   HsAppsTy (L _ (HsAppPrefix typHead):typRestA)     | Just typRest <- mapM (\case L _ (HsAppPrefix t) -> Just t@@ -350,7 +350,8 @@       ]     where       layoutAppType (L _ (HsAppPrefix t)) = layoutType t-      layoutAppType (L _ (HsAppInfix t))  = docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecial t+      layoutAppType lt@(L _ (HsAppInfix t)) =+        docLit =<< lrdrNameToTextAnnTypeEqualityIsSpecialAndRespectTick lt t   HsListTy typ1 -> do     typeDoc1 <- docSharedWrapper layoutType typ1     docAlt

@@ -72,12 +72,11 @@      )   => BriDocNumbered   -> MultiRWSS.MultiRWS r w s BriDoc-transformAlts briDoc =+transformAlts =   MultiRWSS.withMultiStateA (AltCurPos 0 0 0 AltLineModeStateNone)-    $ Memo.startEvalMemoT-    $ fmap unwrapBriDocNumbered-    $ rec-    $ briDoc+    . Memo.startEvalMemoT+    . fmap unwrapBriDocNumbered+    . rec   where     -- this function is exponential by nature and cannot be improved in any     -- way i can think of, and i've tried. (stupid StableNames.)@@ -301,6 +300,8 @@           reWrap . BDFAnnotationRest annKey <$> rec bd         BDFAnnotationKW annKey kw bd ->           reWrap . BDFAnnotationKW annKey kw <$> rec bd+        BDFMoveToKWDP annKey kw bd ->+          reWrap . BDFMoveToKWDP annKey kw <$> rec bd         BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.         BDFLines (l:lr) -> do           ind <- _acp_indent <$> mGet@@ -319,11 +320,16 @@                 BrIndentNone -> 0                 BrIndentRegular -> indAmount                 BrIndentSpecial i -> i-          mSet $ acp { _acp_indentPrep = 0 -- TODO: i am not sure this is valid,-                                           -- in general.-                     , _acp_indent = _acp_indent acp + indAdd-                     , _acp_line = _acp_line acp + indAdd-                     }+          mSet $ acp+            { _acp_indentPrep = 0+              -- TODO: i am not sure this is valid, in general.+            , _acp_indent = _acp_indent acp + indAdd+            , _acp_line = max (_acp_line acp) (_acp_indent acp + indAdd)+              -- we cannot use just _acp_line acp + indAdd because of the case+              -- where there are multiple BDFEnsureIndents in the same line.+              -- Then, the actual indentation is relative to the current+              -- indentation, not the current cursor position.+            }           r <- rec bd           acp' <- mGet           mSet $ acp' { _acp_indent = _acp_indent acp }@@ -455,6 +461,7 @@       BDFAnnotationPrior _annKey bd -> rec bd       BDFAnnotationKW _annKey _kw bd -> rec bd       BDFAnnotationRest  _annKey bd -> rec bd+      BDFMoveToKWDP _annKey _kw bd -> rec bd       BDFLines [] -> return         $ LineModeValid         $ VerticalSpacing 0 VerticalSpacingParNone False@@ -700,6 +707,7 @@         BDFAnnotationPrior _annKey bd -> rec bd         BDFAnnotationKW _annKey _kw bd -> rec bd         BDFAnnotationRest  _annKey bd -> rec bd+        BDFMoveToKWDP _annKey _kw bd -> rec bd         BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]         BDFLines ls@(_:_) -> do           -- we simply assume that lines is only used "properly", i.e. in@@ -712,11 +720,12 @@                       $ sequence                       $ reverse                       $ lSpss-              summed = worbled <&> \lSps@(lSp1:_) ->-                VerticalSpacing (_vs_sameLine lSp1) -                                (spMakePar $ maxVs lSps)-                                False-          return $ summed+              sumF lSps@(lSp1:_) = VerticalSpacing (_vs_sameLine lSp1)+                                                   (spMakePar $ maxVs lSps)+                                                   False+              sumF [] = error $ "should not happen. if my logic does not fail"+                             ++ "me, this follows from not (null ls)."+          return $ sumF <$> worbled           -- lSpss@(mVs:_) <- rec `mapM` ls           -- return $ case Control.Lens.transposeOf traverse lSpss of -- TODO: we currently only           --                      -- consider the first alternative for the@@ -749,6 +758,34 @@                   VerticalSpacingParAlways i -> VerticalSpacingParAlways i                   VerticalSpacingParSome i -> VerticalSpacingParAlways i               }+            -- the version below is an alternative idea: fold the input+            -- spacings into a single spacing. This was hoped to improve in+            -- certain cases where non-bottom alternatives took up "too much+            -- explored search space"; the downside is that it also cuts+            -- the search-space short in other cases where it is not necessary,+            -- leading to unnecessary new-lines. Disabled for now. A better+            -- solution would require conditionally folding the search-space+            -- only in appropriate locations (i.e. a new BriDoc node type+            -- for this purpose, perhaps "BDFNonBottomSpacing1").+            -- else+            --   [ Foldable.foldl1+            --     (\(VerticalSpacing x1 x2 _) (VerticalSpacing y1 y2 _) ->+            --       VerticalSpacing+            --         (min x1 y1)+            --         (case (x2, y2) of+            --           (x, VerticalSpacingParNone) -> x+            --           (VerticalSpacingParNone, x) -> x+            --           (VerticalSpacingParAlways i, VerticalSpacingParAlways j) ->+            --             VerticalSpacingParAlways $ min i j+            --           (VerticalSpacingParAlways i, VerticalSpacingParSome j) ->+            --             VerticalSpacingParAlways $ min i j+            --           (VerticalSpacingParSome i, VerticalSpacingParAlways j) ->+            --             VerticalSpacingParAlways $ min i j+            --           (VerticalSpacingParSome x, VerticalSpacingParSome y) ->+            --             VerticalSpacingParSome $ min x y)+            --         False)+            --     mVs+            --   ]         BDFSetParSpacing bd -> do           mVs <- rec bd           return $ mVs <&> \vs -> vs { _vs_parFlag = True }

@@ -23,11 +23,12 @@   BDLit{} -> Nothing   BDSeq list | any (\case BDSeq{} -> True                           BDEmpty{} -> True-                          _ -> False) list -> Just $ BDSeq $-    filter isNotEmpty list >>= \case-      BDSeq l -> l-      x -> [x]-  BDSeq (BDCols sig1 cols1@(_:_):rest) ->+                          _ -> False) list -> Just $ BDSeq $ list >>= \case+                            BDEmpty -> []+                            BDSeq l -> l+                            x -> [x]+  BDSeq (BDCols sig1 cols1@(_:_):rest)+    | all (\case BDSeparator -> True; _ -> False) rest ->     Just $ BDCols sig1 (List.init cols1 ++ [BDSeq (List.last cols1:rest)])   BDLines lines | any (\case BDLines{} -> True                              BDEmpty{} -> True@@ -128,6 +129,7 @@   BDAnnotationPrior{} -> Nothing   BDAnnotationKW{}    -> Nothing   BDAnnotationRest{}  -> Nothing+  BDMoveToKWDP{}      -> Nothing   BDEnsureIndent{}    -> Nothing   BDSetParSpacing{}   -> Nothing   BDForceParSpacing{} -> Nothing

@@ -101,9 +101,9 @@         Just $ BDDebug s (BDIndentLevelPop x)       _ -> Nothing     descendAddB = transformDownMay $ \case-      -- AddIndent floats into Lines.       BDAddBaseY BrIndentNone x ->         Just x+      -- AddIndent floats into Lines.       BDAddBaseY indent (BDLines lines) ->         Just $ BDLines $ BDAddBaseY indent <$> lines       -- AddIndent floats into last column@@ -145,9 +145,9 @@           x -> x     stepFull = -- traceFunctionWith "stepFull" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $                Uniplate.rewrite $ \case-      -- AddIndent floats into Lines.       BDAddBaseY BrIndentNone x ->         Just $ x+      -- AddIndent floats into Lines.       BDAddBaseY indent (BDLines lines) ->         Just $ BDLines $ BDAddBaseY indent <$> lines       -- AddIndent floats into last column

@@ -174,10 +174,11 @@   | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect?   | ColListComp   | ColList-  | ColApp+  | ColApp Text   | ColTuple   | ColTuples   | ColOpPrefix -- merge with ColList ? other stuff?+  | ColImport    -- TODO   deriving (Eq, Ord, Data.Data.Data, Show)@@ -232,6 +233,7 @@   | BDAnnotationPrior AnnKey BriDoc   | BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc   | BDAnnotationRest  AnnKey BriDoc+  | BDMoveToKWDP AnnKey AnnKeywordId BriDoc   | BDLines [BriDoc]   | BDEnsureIndent BrIndent BriDoc   -- the following constructors are only relevant for the alt transformation@@ -277,6 +279,7 @@   | BDFAnnotationPrior AnnKey (f (BriDocF f))   | BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))   | BDFAnnotationRest  AnnKey (f (BriDocF f))+  | BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))   | BDFLines [(f (BriDocF f))]   | BDFEnsureIndent BrIndent (f (BriDocF f))   | BDFForceMultiline (f (BriDocF f))@@ -310,6 +313,7 @@   uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd   uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd   uniplate (BDAnnotationRest annKey bd)  = plate BDAnnotationRest |- annKey |* bd+  uniplate (BDMoveToKWDP annKey kw bd)   = plate BDMoveToKWDP |- annKey |- kw |* bd   uniplate (BDLines lines)               = plate BDLines ||* lines   uniplate (BDEnsureIndent ind bd)       = plate BDEnsureIndent |- ind |* bd   uniplate (BDForceMultiline   bd)       = plate BDForceMultiline |* bd@@ -341,6 +345,7 @@   BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd   BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd   BDFAnnotationRest annKey bd  -> BDAnnotationRest annKey $ rec bd+  BDFMoveToKWDP annKey kw bd   -> BDMoveToKWDP annKey kw $ rec bd   BDFLines lines               -> BDLines $ rec <$> lines   BDFEnsureIndent ind bd       -> BDEnsureIndent ind $ rec bd   BDFForceMultiline   bd       -> BDForceMultiline $ rec bd@@ -376,6 +381,7 @@   BDAnnotationPrior _annKey bd  -> briDocSeqSpine bd   BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd   BDAnnotationRest _annKey bd   -> briDocSeqSpine bd+  BDMoveToKWDP _annKey _kw bd   -> briDocSeqSpine bd   BDLines lines                 -> foldl' (\(!()) -> briDocSeqSpine) () lines   BDEnsureIndent _ind bd        -> briDocSeqSpine bd   BDForceMultiline   bd         -> briDocSeqSpine bd