ormolu 0.0.2.0 → 0.0.3.0

raw patch · 69 files changed

+547/−201 lines, 69 filesdep ~ghc-lib-parserPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: ghc-lib-parser

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• data/examples/declaration/class/associated-data1-out.hs +0/−1
• data/examples/declaration/class/associated-data2-out.hs +0/−1
• data/examples/declaration/class/associated-type-defaults-out.hs +0/−2
• data/examples/declaration/class/associated-types1-out.hs +0/−1
• data/examples/declaration/class/associated-types2-out.hs +0/−1
• data/examples/declaration/class/default-implementations-comments-out.hs +0/−1
• data/examples/declaration/class/default-signatures-out.hs +0/−2
• data/examples/declaration/class/default-signatures-simple-out.hs +0/−2
• data/examples/declaration/class/dependency-super-classes-out.hs +0/−3
• data/examples/declaration/class/multi-parameters2-out.hs +0/−2
• data/examples/declaration/class/newlines-after-where-out.hs +5/−0
• data/examples/declaration/class/newlines-after-where.hs +7/−0
• data/examples/declaration/class/newlines-and-default-decls-out.hs +11/−0
• data/examples/declaration/class/newlines-and-default-decls.hs +13/−0
• data/examples/declaration/class/newlines-and-haddocks-out.hs +23/−0
• data/examples/declaration/class/newlines-and-haddocks.hs +19/−0
• data/examples/declaration/class/newlines-between-methods-out.hs +17/−0
• data/examples/declaration/class/newlines-between-methods.hs +15/−0
• data/examples/declaration/class/single-parameters-out.hs +0/−2
• data/examples/declaration/instance/associated-data-out.hs +0/−2
• data/examples/declaration/instance/associated-data.hs +1/−0
• data/examples/declaration/instance/associated-types-out.hs +0/−1
• data/examples/declaration/instance/associated-types.hs +2/−0
• data/examples/declaration/instance/instance-sigs-multiple-out.hs +0/−2
• data/examples/declaration/instance/multi-parameter-out.hs +0/−2
• data/examples/declaration/instance/newlines-after-where-out.hs +5/−0
• data/examples/declaration/instance/newlines-after-where.hs +7/−0
• data/examples/declaration/instance/newlines-between-methods-out.hs +18/−0
• data/examples/declaration/instance/newlines-between-methods.hs +16/−0
• data/examples/declaration/instance/single-parameter-out.hs +0/−2
• data/examples/declaration/signature/minimal/minimal-out.hs +0/−2
• data/examples/declaration/signature/specialize/specialize-instance-out.hs +0/−4
• data/examples/declaration/value/function/block-arguments-out.hs +5/−0
• data/examples/declaration/value/function/block-arguments.hs +5/−0
• data/examples/declaration/value/function/multi-way-if-out.hs +9/−5
• data/examples/declaration/value/function/multi-way-if.hs +5/−0
• data/examples/declaration/value/function/overindentation-out.hs +11/−9
• data/examples/declaration/value/function/record-constructors-out.hs +17/−13
• data/examples/declaration/value/function/record-dot-out.hs +7/−0
• data/examples/declaration/value/function/record-dot.hs +6/−0
• data/examples/declaration/value/function/record-inter-comments-out.hs +13/−0
• data/examples/declaration/value/function/record-inter-comments.hs +11/−0
• data/examples/declaration/value/function/record-wildcards-out.hs +7/−6
• data/examples/declaration/value/function/type-applications-out.hs +6/−0
• data/examples/declaration/value/function/type-applications.hs +5/−0
• data/examples/other/comment-alignment-out.hs +0/−1
• data/examples/other/comment-before-hanging-out.hs +5/−0
• data/examples/other/comment-before-hanging.hs +5/−0
• ormolu.cabal +3/−3
• src/GHC/DynFlags.hs +9/−7
• src/Ormolu.hs +4/−5
• src/Ormolu/Config.hs +8/−7
• src/Ormolu/Diff.hs +1/−1
• src/Ormolu/Parser.hs +16/−10
• src/Ormolu/Parser/Result.hs +3/−1
• src/Ormolu/Printer.hs +1/−0
• src/Ormolu/Printer/Comments.hs +2/−2
• src/Ormolu/Printer/Internal.hs +33/−21
• src/Ormolu/Printer/Meat/Common.hs +7/−7
• src/Ormolu/Printer/Meat/Declaration.hs +51/−14
• src/Ormolu/Printer/Meat/Declaration.hs-boot +2/−2
• src/Ormolu/Printer/Meat/Declaration/Class.hs +5/−8
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +1/−4
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +3/−3
• src/Ormolu/Printer/Meat/Declaration/Value.hs +77/−34
• src/Ormolu/Printer/Meat/Module.hs +3/−3
• src/Ormolu/Printer/Operators.hs +1/−2
• src/Ormolu/Utils.hs +16/−0

@@ -1,3 +1,28 @@+## Ormolu 0.0.3.0++* Fixed an issue related to unnecessary use of curly braces. [Issue+  473](https://github.com/tweag/ormolu/issues/473).++* Fixed the issue with formatting multi-way if when it happens to be a+  function applied to arguments [Issue+  488](https://github.com/tweag/ormolu/issues/488). This changed the way+  multi-line if is formatted in general.++* Added support for record dot pre-processor when used via the plugin.+  [Issue 486](https://github.com/tweag/ormolu/issues/486).++* Stopped hanging record constructors and improved placing+  potentially-hanging consturctions in the presence of comments. [Issue+  447](https://github.com/tweag/ormolu/issues/447).++* Fixed indentation in presence of type applications. [Issue+  493](https://github.com/tweag/ormolu/issues/493).++* Class and instance declarations now do not have a blank line after+  `where`. Grouping of methods from the original input is also preserved+  with some normalizations. [Issue+  431](https://github.com/tweag/ormolu/issues/431).+ ## Ormolu 0.0.2.0  * Switched to `ghc-lib-parser` instead of depending on the `ghc` package

@@ -4,7 +4,6 @@  -- | Something. class Bar a where-   -- | Bar bar   data BarBar a 

@@ -4,7 +4,6 @@  -- | Something more. class Baz a where-   -- | Baz bar   data     BazBar

@@ -4,7 +4,6 @@  -- | Something. class Bar a where-   -- Define bar   type     BarBar a =@@ -18,7 +17,6 @@         a  class Baz a where-   type     BazBar       a

@@ -4,7 +4,6 @@  -- | Something. class Bar a where-   -- | Bar bar   type BarBar a 

@@ -4,7 +4,6 @@  -- | Something more. class Baz a where-   -- | Baz bar   type     BazBar

@@ -2,7 +2,6 @@  -- | Baz class Baz a where-   foobar :: a -> a   foobar a =     barbaz (bazbar a)

@@ -4,13 +4,11 @@  -- | Something else. class Bar a where-   -- | Bar   bar ::     String ->     String ->     a-   -- Pointless comment   default bar ::     ( Read a,

@@ -2,9 +2,7 @@  -- | Something. class Foo a where-   -- | Foo   foo :: a -> String-   default foo :: Show a => a -> String   foo = show

@@ -4,9 +4,7 @@  -- | Something. class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where-   get :: m s-   put :: s -> m ()  -- | 'MonadParsec'@@ -16,7 +14,6 @@   ) =>   MonadParsec e s m     | m -> e s where-   -- | 'getState' returns state   getState ::     m s

@@ -11,10 +11,8 @@     d -- Baz baz     e -- Rest     f where-   barbaz ::     a -> f-   bazbar ::     e ->     f

@@ -0,0 +1,5 @@+class Num a where+  (+) :: a -> a -> a++class Num a where+  (+) :: a -> a -> a

@@ -0,0 +1,7 @@+class Num a where+  (+) :: a -> a -> a++class Num a where+++  (+) :: a -> a -> a

@@ -0,0 +1,11 @@+class Foo a where+  foo :: a+  default foo :: ()+  foo = ()+  bar :: a+  default bar :: ()+  bar = ()++  qux :: a+  default qux :: ()+  qux = ()

@@ -0,0 +1,13 @@+class Foo a where+  foo :: a+  default foo :: ()+  foo = ()+  bar :: a+  default bar :: ()+  bar = ()++  qux :: a++  default qux :: ()++  qux = ()

@@ -0,0 +1,23 @@+class Foo a where+  -- | Haddock+  foo :: a++  -- | Another Haddock+  bar :: a++  baz :: a+  -- ^ Post-Haddock++  raz :: a+  -- ^ Another Post-Haddock++  -- | One more Haddock+  qux :: a++  -- Comment before a Haddock++  -- | And one more Haddock+  xyz :: a++  -- | Haddock followed by a blank line+  abc :: a

@@ -0,0 +1,19 @@+class Foo a where+  -- | Haddock+  foo :: a+  -- | Another Haddock+  bar :: a+  baz :: a+  -- ^ Post-Haddock+  raz :: a+  -- ^ Another Post-Haddock++  -- | One more Haddock+  qux :: a+  -- Comment before a Haddock+  -- | And one more Haddock+  xyz :: a++  -- | Haddock followed by a blank line++  abc :: a

@@ -0,0 +1,17 @@+class Num a where+  (+) :: a -> a -> a+  (-) :: a -> a -> a+  (*) :: a -> a -> a++  -- Comment before definition+  negate :: a -> a++  -- Comment after definition++  -- Separator++  abs :: a -> a+  signum :: a -> a++  -- Comment between unrelated definitions+  fromInteger :: Integer -> a

@@ -0,0 +1,15 @@+class Num a where+  (+) :: a -> a -> a+  (-) :: a -> a -> a+  (*) :: a -> a -> a++  -- Comment before definition+  negate :: a -> a+  -- Comment after definition++  -- Separator++  abs :: a -> a+  signum :: a -> a+  -- Comment between unrelated definitions+  fromInteger :: Integer -> a

@@ -21,8 +21,6 @@     a  class BarBaz a where-   barbaz ::     a -> b-   bazbar :: b -> a

@@ -11,9 +11,7 @@         Double  instance Foo [a] where-   data Bar [a]     = ListBar [Bar a]-   data Baz [a]     = ListBaz

@@ -13,6 +13,7 @@  instance Foo [a]   where+     data Bar [a] =             ListBar [Bar a]     data Baz [a] =

@@ -3,7 +3,6 @@ instance Foo Int where type Bar Int = Double  instance Foo Double where-   type     Bar       Double =

@@ -9,5 +9,7 @@         Double         =           [Double]++     type instance Baz  Double       = [Double]

@@ -1,12 +1,10 @@ {-# LANGUAGE InstanceSigs #-}  instance Applicative [] where-   pure ::     a ->     [a]   pure a = [a]-   (<*>) ::     [a] -> [a] -> [a]   (<*>) _ _ = []

@@ -1,7 +1,5 @@ instance MonadReader a ((->) a) where ask = id  instance MonadState s (State s) where-   get = State.get-   put = State.put

@@ -0,0 +1,5 @@+instance Num X where+  (+) = undefined++instance Num Y where+  (+) = undefined

@@ -0,0 +1,7 @@+instance Num X where+  (+) = undefined++instance Num Y where+++  (+) = undefined

@@ -0,0 +1,18 @@+instance Num a => Num (Diff a) where+  D u dudx + D v dvdx = D (u + v) (dudx + dvdx)+  D u dudx - D v dvdx = D (u - v) (dudx - dvdx)+  D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)++  -- Comment before definition+  negate (D u dudx) = D (- u) (- dudx)+  negate (Z u dudx) = undefined++  -- Comment after definition++  -- Separator++  abs (D u _) = D (abs u) (signum u)+  signum (D u _) = D (signum u) 0++  -- Comment between unrelated definitions+  fromInteger n = D (fromInteger n) 0

@@ -0,0 +1,16 @@+instance Num a => Num (Diff a) where+  D u dudx + D v dvdx = D (u + v) (dudx + dvdx)+  D u dudx - D v dvdx = D (u - v) (dudx - dvdx)+  D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)++  -- Comment before definition+  negate (D u dudx) = D (-u) (-dudx)+  negate (Z u dudx) = undefined+  -- Comment after definition++  -- Separator++  abs (D u _) = D (abs u) (signum u)+  signum (D u _) = D (signum u) 0+  -- Comment between unrelated definitions+  fromInteger n = D (fromInteger n) 0

@@ -1,9 +1,7 @@ instance Monoid Int where (<>) x y = x + y  instance Enum Int where-   fromEnum x = x-   toEnum =     \x ->       x

@@ -1,5 +1,4 @@ class Foo a where-   {-# MINIMAL (==) | ((/=), foo) #-}    {-# MINIMAL@@ -12,5 +11,4 @@     #-}    (==) :: a -> a -> Bool-   (/=) :: a -> a -> Bool

@@ -3,16 +3,12 @@ data VT v m r = VT v m r  instance (Eq a) => Eq (Foo a) where-   {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}-   (==) (Foo a) (Foo b) = (==) a b  instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where-   {-# SPECIALIZE instance     ( Factored m Int => Num (VT U.Vector m Int)     )     #-}-   VT x + VT y = VT $ V.zipWith (+) x y

@@ -27,3 +27,8 @@   y  f9 = foo do { bar } baz++f10 = foo+  do a+  do b+  do c

@@ -23,3 +23,8 @@   y  f9 = foo do { bar } baz++f10 = foo+  do { a }+  do { b }+  do c

@@ -3,8 +3,12 @@ foo x = if | x == 5 -> 5  bar x y =-  if-    | x > y -> x-    | x < y ->-      y-    | otherwise -> x+  if  | x > y -> x+      | x < y ->+        y+      | otherwise -> x++baz =+  if  | p -> f+      | otherwise -> g+    x

@@ -7,3 +7,8 @@     |  x < y         -> y     | otherwise  -> x++baz =+  if | p -> f+     | otherwise -> g+    x

@@ -1,9 +1,11 @@-reallyincrediblyLongName = f-  a-  A-    { reallyincrediblyLongName = f-        a-        A-          { reallyincrediblyLongName-          }-    }+reallyincrediblyLongName =+  f+    a+    A+      { reallyincrediblyLongName =+          f+            a+            A+              { reallyincrediblyLongName+              }+      }

@@ -1,9 +1,10 @@ foo = Foo {a = 3} -bar = Bar-  { abc = foo,-    def = Foo {a = 10}-  }+bar =+  Bar+    { abc = foo,+      def = Foo {a = 10}+    }  baz = Baz {} @@ -12,15 +13,18 @@ aLongVariableName =   ALongRecordName     { short = baz,-      aLongRecordFieldName = YetAnotherLongRecordName-        { yetAnotherLongRecordFieldName = "a long string"-        },-      aLongRecordFieldName2 = Just YetAnotherLongRecordName-        { yetAnotherLongRecordFieldName = "a long string",-          yetAnotherLongRecordFieldName =-            Just-              "a long string"-        },+      aLongRecordFieldName =+        YetAnotherLongRecordName+          { yetAnotherLongRecordFieldName = "a long string"+          },+      aLongRecordFieldName2 =+        Just+          YetAnotherLongRecordName+            { yetAnotherLongRecordFieldName = "a long string",+              yetAnotherLongRecordFieldName =+                Just+                  "a long string"+            },       aLongRecordFieldName3 = do         foo         bar

@@ -0,0 +1,7 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}++data Foo = Foo {bar :: Int}++mfoo = fmap (.bar) $ Nothing++bar = (Foo 1).bar

@@ -0,0 +1,6 @@+{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}+data Foo = Foo { bar :: Int }++mfoo = fmap (.bar)   $ Nothing++bar = (  Foo 1).bar

@@ -0,0 +1,13 @@+x =+  Just+    -- comment+    A+      { x+      }++x =+  Just+    -- comment+    a+      { x+      }

@@ -0,0 +1,11 @@+x = Just+  -- comment+  A+   { x+   }++x = Just+  -- comment+  a+   { x+   }

@@ -3,11 +3,12 @@  foo x y = Foo {x, y} -bar x y z = Bar-  { x,-    y,-    z,-    ..-  }+bar x y z =+  Bar+    { x,+      y,+      z,+      ..+    }  baz = Baz {..}

@@ -8,3 +8,9 @@   f @Int @String     a     b++goo =+  hash+    @(HASH TPraosStandardCrypto)+    @ByteString+    "And the lamb lies down on Broadway"

@@ -6,3 +6,8 @@  baz = f @Int @String   a b++goo = hash+  @(HASH TPraosStandardCrypto)+  @ByteString+  "And the lamb lies down on Broadway"

@@ -1,5 +1,4 @@ class Foo a where-   -- | Foo.   foo ::     Int ->

@@ -0,0 +1,5 @@+x = Just+  -- comment+  do+    foo+    bar

@@ -0,0 +1,5 @@+x = Just+  -- comment+  do+    foo+    bar

@@ -1,5 +1,5 @@ name:                 ormolu-version:              0.0.2.0+version:              0.0.3.0 cabal-version:        1.18 tested-with:          GHC==8.6.5 license:              BSD3@@ -68,7 +68,7 @@                     , containers     >= 0.5 && < 0.7                     , dlist          >= 0.8 && < 0.9                     , exceptions     >= 0.6 && < 0.11-                    , ghc-lib-parser == 8.8.1+                    , ghc-lib-parser >= 8.8.1 && < 8.8.2                     , mtl            >= 2.0 && < 3.0                     , syb            >= 0.7 && < 0.8                     , text           >= 0.2 && < 1.3@@ -150,7 +150,7 @@   main-is:            Main.hs   hs-source-dirs:     app   build-depends:      base           >= 4.12 && < 5.0-                    , ghc-lib-parser == 8.8.1+                    , ghc-lib-parser >= 8.8.1 && < 8.8.2                     , gitrev         >= 1.3 && < 1.4                     , optparse-applicative >= 0.14 && < 0.15                     , ormolu

@@ -12,13 +12,15 @@  -- | Taken from HLint. fakeSettings :: Settings-fakeSettings = Settings-  { sTargetPlatform = platform,-    sPlatformConstants = platformConstants,-    sProjectVersion = cProjectVersion,-    sProgramName = "ghc",-    sOpt_P_fingerprint = fingerprint0-  }+fakeSettings =+  Settings+    { sTargetPlatform = platform,+      sPlatformConstants = platformConstants,+      sProjectVersion = cProjectVersion,+      sProgramName = "ghc",+      sOpt_P_fingerprint = fingerprint0,+      sPgm_F = ""+    }   where     platform =       Platform

@@ -55,11 +55,10 @@     traceM "warnings:\n"     traceM (concatMap showWarn warnings)     traceM (prettyPrintParseResult result0)-  -- NOTE We're forcing 'txt' here because otherwise errors (such as-  -- messages about not-yet-supported functionality) will be thrown later-  -- when we try to parse the rendered code back, inside of GHC monad-  -- wrapper which will lead to error messages presenting the exceptions as-  -- GHC bugs.+  -- We're forcing 'txt' here because otherwise errors (such as messages+  -- about not-yet-supported functionality) will be thrown later when we try+  -- to parse the rendered code back, inside of GHC monad wrapper which will+  -- lead to error messages presenting the exceptions as GHC bugs.   let !txt = printModule result0   when (not (cfgUnsafe cfg) || cfgCheckIdempotency cfg) $ do     let pathRendered = path ++ "<rendered>"

@@ -29,13 +29,14 @@  -- | Default 'Config'. defaultConfig :: Config-defaultConfig = Config-  { cfgDynOptions = [],-    cfgUnsafe = False,-    cfgDebug = False,-    cfgTolerateCpp = False,-    cfgCheckIdempotency = False-  }+defaultConfig =+  Config+    { cfgDynOptions = [],+      cfgUnsafe = False,+      cfgDebug = False,+      cfgTolerateCpp = False,+      cfgCheckIdempotency = False+    }  -- | A wrapper for dynamic options. newtype DynOption

@@ -55,7 +55,7 @@   where     genericQuery :: GenericQ (GenericQ Diff)     genericQuery x y-      -- NOTE 'ByteString' implements 'Data' instance manually and does not+      -- 'ByteString' implements 'Data' instance manually and does not       -- implement 'toConstr', so we have to deal with it in a special way.       | Just x' <- cast x,         Just y' <- cast y =

@@ -16,7 +16,6 @@ import Data.List ((\\), foldl', isPrefixOf) import qualified Data.List.NonEmpty as NE import Data.Maybe (catMaybes)-import qualified DynFlags as GHC import DynFlags as GHC import qualified FastString as GHC import GHC hiding (IE, UnicodeSyntax)@@ -50,7 +49,7 @@     ) parseModule Config {..} path input' = liftIO $ do   let (input, extraComments) = extractCommentsFromLines path input'-  -- NOTE It's important that 'setDefaultExts' is done before+  -- It's important that 'setDefaultExts' is done before   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an   -- extension that was explicitly disabled in the file.   let baseFlags =@@ -69,18 +68,25 @@          in throwIO (OrmoluParsingFailed loc err)   when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $     throwIO (OrmoluCppEnabled path)-  let r = case runParser GHC.parseModule dynFlags path input of+  let useRecordDot =+        "record-dot-preprocessor" == pgm_F dynFlags+          || any+            (("RecordDotPreprocessor" ==) . moduleNameString)+            (pluginModNames dynFlags)+      r = case runParser GHC.parseModule dynFlags path input of         GHC.PFailed _ ss m ->           Left (ss, GHC.showSDoc dynFlags m)         GHC.POk pstate pmod ->           let (comments, exts, shebangs) = mkCommentStream extraComments pstate-           in Right ParseResult-                { prParsedSource = pmod,-                  prAnns = mkAnns pstate,-                  prCommentStream = comments,-                  prExtensions = exts,-                  prShebangs = shebangs-                }+           in Right+                ParseResult+                  { prParsedSource = pmod,+                    prAnns = mkAnns pstate,+                    prCommentStream = comments,+                    prExtensions = exts,+                    prShebangs = shebangs,+                    prUseRecordDot = useRecordDot+                  }   return (warnings, r)  -- | Extensions that are not enabled automatically and should be activated

@@ -24,7 +24,9 @@         -- | Extensions enabled in that module         prExtensions :: [Pragma],         -- | Shebangs found in the input-        prShebangs :: [Located String]+        prShebangs :: [Located String],+        -- | Whether or not record dot syntax is enabled+        prUseRecordDot :: Bool       }  -- | Pretty-print a 'ParseResult'.

@@ -24,3 +24,4 @@     (mkSpanStream prParsedSource)     prCommentStream     prAnns+    prUseRecordDot

@@ -81,8 +81,8 @@   withPoppedComment p $ \l comment -> do     dirtyLine <-       case mlastSpn of-        -- NOTE When the current line is dirty it means that something that-        -- can have comments attached to it is already on the line. To avoid+        -- When the current line is dirty it means that something that can+        -- have comments attached to it is already on the line. To avoid         -- problems with idempotence we cannot output the first comment         -- immediately because it'll be attached to the previous element (on         -- the same line) on the next run, so we play safe here and output

@@ -17,6 +17,7 @@     space,     newline,     isLineDirty,+    useRecordDot,     inci,     sitcc,     Layout (..),@@ -83,8 +84,10 @@         rcEnclosingSpans :: [RealSrcSpan],         -- | Collection of annotations         rcAnns :: Anns,-        -- | If the last expression in the layout can use braces-        rcCanUseBraces :: Bool+        -- | Whether the last expression in the layout can use braces+        rcCanUseBraces :: Bool,+        -- | Whether the source could have used the record dot preprocessor+        rcUseRecDot :: Bool       }  -- | State context of 'R'.@@ -150,28 +153,33 @@   CommentStream ->   -- | Annotations   Anns ->+  -- | Use Record Dot Syntax+  Bool ->   -- | Resulting rendition   Text-runR (R m) sstream cstream anns =+runR (R m) sstream cstream anns recDot =   TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc   where-    rc = RC-      { rcIndent = 0,-        rcLayout = MultiLine,-        rcEnclosingSpans = [],-        rcAnns = anns,-        rcCanUseBraces = False-      }-    sc = SC-      { scColumn = 0,-        scBuilder = mempty,-        scSpanStream = sstream,-        scCommentStream = cstream,-        scPendingComments = [],-        scDirtyLine = False,-        scRequestedDelimiter = VeryBeginning,-        scLastCommentSpan = Nothing-      }+    rc =+      RC+        { rcIndent = 0,+          rcLayout = MultiLine,+          rcEnclosingSpans = [],+          rcAnns = anns,+          rcCanUseBraces = False,+          rcUseRecDot = recDot+        }+    sc =+      SC+        { scColumn = 0,+          scBuilder = mempty,+          scSpanStream = sstream,+          scCommentStream = cstream,+          scPendingComments = [],+          scDirtyLine = False,+          scRequestedDelimiter = VeryBeginning,+          scLastCommentSpan = Nothing+        }  ---------------------------------------------------------------------------- -- Internal functions@@ -234,7 +242,7 @@           scDirtyLine = scDirtyLine sc || dirty,           scRequestedDelimiter = RequestedNothing,           scLastCommentSpan =-            -- NOTE If there are pending comments, do not reset last comment+            -- If there are pending comments, do not reset last comment             -- location.             if printingComments || (not . null . scPendingComments) sc               then scLastCommentSpan sc@@ -315,6 +323,10 @@ -- that can have comments attached to it. isLineDirty :: R Bool isLineDirty = R (gets scDirtyLine)++-- | Return 'True' if we should print record dot syntax.+useRecordDot :: R Bool+useRecordDot = R $ asks rcUseRecDot  -- | Increase indentation level by one indentation step for the inner -- computation. 'inci' should be used when a part of code must be more

@@ -76,10 +76,10 @@           Qual mname occName ->             p_qualName mname occName           Orig _ occName ->-            -- NOTE This is used when GHC generates code that will be fed-            -- into the renamer (e.g. from deriving clauses), but where we-            -- want to say that something comes from given module which is-            -- not specified in the source code, e.g. @Prelude.map@.+            -- This is used when GHC generates code that will be fed into+            -- the renamer (e.g. from deriving clauses), but where we want+            -- to say that something comes from given module which is not+            -- specified in the source code, e.g. @Prelude.map@.             --             -- My current understanding is that the provided module name             -- serves no purpose for us and can be safely ignored.@@ -99,9 +99,9 @@ doesNotNeedExtraParens = \case   Exact name ->     let s = nameStableString name-     in -- NOTE I'm not sure this "stable string" is stable enough, but it looks-        -- like this is the most robust way to tell if we're looking at exactly-        -- this piece of built-in syntax.+     in -- I'm not sure this "stable string" is stable enough, but it looks+        -- like this is the most robust way to tell if we're looking at+        -- exactly this piece of built-in syntax.         ("$ghc-prim$GHC.Tuple$" `isPrefixOf` s)           || ("$ghc-prim$GHC.Types$[]" `isPrefixOf` s)   _ -> False

@@ -7,7 +7,7 @@ -- | Rendering of declarations. module Ormolu.Printer.Meat.Declaration   ( p_hsDecls,-    hasSeparatedDecls,+    p_hsDeclsRespectGrouping,   ) where @@ -36,19 +36,53 @@ import Ormolu.Utils import RdrName (rdrNameOcc) +data UserGrouping+  = -- | Always put newlines where we think they should be+    Disregard+  | -- | Respect user preferences regarding grouping+    Respect+  deriving (Eq, Show)+ p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()-p_hsDecls style decls = sepSemi id $+p_hsDecls = p_hsDecls' Disregard++-- | Like 'p_hsDecls' but respects user choices regarding grouping. If the+-- user omits newlines between declarations, we also omit them in most+-- cases, except when said declarations have associated Haddocks.+--+-- Does some normalization (compress subsequent newlines into a single one)+p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDeclsRespectGrouping = p_hsDecls' Respect++p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDecls' grouping style decls = sepSemi id $   -- Return a list of rendered declarations, adding a newline to separate   -- groups.   case groupDecls decls of     [] -> []-    (x : xs) ->-      NE.toList (renderGroup x)-        ++ concatMap (NE.toList . separateGroup . renderGroup) xs+    (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)   where-    renderGroup = fmap (located' $ dontUseBraces . p_hsDecl style)-    separateGroup (x :| xs) = (breakpoint' >> x) :| xs+    renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)+    renderGroupWithPrev prev curr =+      -- We can omit a blank line when the user didn't add one, but we must+      -- ensure we always add blank lines around documented declarations+      if or+        [ grouping == Disregard,+          separatedByBlank getLoc prev curr,+          isDocumented prev,+          isDocumented curr+        ]+        then breakpoint : renderGroup curr+        else renderGroup curr +-- | Is a declaration group documented?+isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool+isDocumented = any (isHaddock . unLoc)+  where+    isHaddock DocNext = True+    isHaddock DocPrev = True+    isHaddock _ = False+ -- | Group relevant declarations together. -- -- Add a declaration to a group iff it is relevant to either the first or@@ -139,6 +173,9 @@   HsDecl GhcPs ->   Bool groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'+groupedDecls (TypeSignature ns) (DefaultSignature ns') = ns `intersects` ns'+groupedDecls (DefaultSignature ns) (TypeSignature ns') = ns `intersects` ns'+groupedDecls (DefaultSignature ns) (FunctionBody ns') = ns `intersects` ns' groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns' groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns' groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns@@ -149,6 +186,7 @@ groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns' groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns' groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns+-- This looks only at Haddocks, normal comments are handled elsewhere groupedDecls DocNext _ = True groupedDecls _ DocPrev = True groupedDecls _ _ = False@@ -164,13 +202,6 @@       | x > y = go (x : xs) ys       | otherwise = True --- | Checks if given list of declarations contain a pair which should--- be separated by a blank line.-hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool-hasSeparatedDecls xs = case groupDecls xs of-  _ : _ : _ -> True-  _ -> False- isPragma ::   HsDecl GhcPs ->   Maybe [RdrName]@@ -206,11 +237,13 @@  pattern   TypeSignature,+  DefaultSignature,   FunctionBody,   PatternSignature,   WarningPragma ::     [RdrName] -> HsDecl GhcPs pattern TypeSignature n <- (sigRdrNames -> Just n)+pattern DefaultSignature n <- (defSigRdrNames -> Just n) pattern FunctionBody n <- (funRdrNames -> Just n) pattern PatternSignature n <- (patSigRdrNames -> Just n) pattern WarningPragma n <- (warnSigRdrNames -> Just n)@@ -224,6 +257,10 @@ sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns sigRdrNames _ = Nothing++defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+defSigRdrNames (SigD NoExt (ClassOpSig NoExt True ns _)) = Just $ map unLoc ns+defSigRdrNames _ = Nothing  funRdrNames :: HsDecl GhcPs -> Maybe [RdrName] funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]

@@ -1,6 +1,6 @@ module Ormolu.Printer.Meat.Declaration   ( p_hsDecls,-    hasSeparatedDecls,+    p_hsDeclsRespectGrouping,   ) where @@ -10,4 +10,4 @@  p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R () -hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool+p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()

@@ -50,10 +50,10 @@           (p_rdrName name)           (located' p_hsTyVarBndr <$> hsq_explicit)       inci (p_classFundeps fdeps)-  -- NOTE GHC's AST does not necessarily store each kind of element in-  -- source location order. This happens because different declarations are-  -- stored in different lists. Consequently, to get all the declarations in-  -- proper order, they need to be manually sorted.+  -- GHC's AST does not necessarily store each kind of element in source+  -- location order. This happens because different declarations are stored+  -- in different lists. Consequently, to get all the declarations in proper+  -- order, they need to be manually sorted.   let sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs       vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs       tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats@@ -68,10 +68,7 @@     space     txt "where"     breakpoint -- Ensure whitespace is added after where clause.-    -- Add newline before first declaration if the body contains separate-    -- declarations.-    when (hasSeparatedDecls allDecls) breakpoint'-    inci (p_hsDecls Associated allDecls)+    inci (p_hsDeclsRespectGrouping Associated allDecls) p_classDecl _ _ XLHsQTyVars {} _ _ _ _ _ _ _ = notImplemented "XLHsQTyVars"  p_classContext :: LHsContext GhcPs -> R ()

@@ -95,10 +95,7 @@           $ do             -- Ensure whitespace is added after where clause.             breakpoint-            -- Add newline before first declaration if the body contains separate-            -- declarations-            when (hasSeparatedDecls allDecls) breakpoint'-            dontUseBraces $ p_hsDecls Associated allDecls+            dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls       XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"   XClsInstDecl NoExt -> notImplemented "XClsInstDecl" 

@@ -35,9 +35,9 @@       Just xs -> do         p_forallBndrs p_hsTyVarBndr xs         space-    -- NOTE It appears that there is no way to tell if there was an empty-    -- forall in the input or no forall at all. We do not want to add-    -- redundant foralls, so let's just skip the empty ones.+    -- It appears that there is no way to tell if there was an empty forall+    -- in the input or no forall at all. We do not want to add redundant+    -- foralls, so let's just skip the empty ones.     unless (null ruleBndrs) $       p_forallBndrs p_ruleBndr ruleBndrs     breakpoint

@@ -18,6 +18,7 @@ import Data.Bool (bool) import Data.Char (isPunctuation, isSymbol) import Data.Data hiding (Infix, Prefix)+import Data.Functor ((<&>)) import Data.List (intersperse, sortOn) import Data.List.NonEmpty ((<|), NonEmpty ((:|))) import qualified Data.List.NonEmpty as NE@@ -26,6 +27,7 @@ import GHC import OccName (mkVarOcc) import Ormolu.Printer.Combinators+import Ormolu.Printer.Internal import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Signature@@ -98,7 +100,7 @@         Case -> id         LambdaCase -> id         _ -> dontUseBraces-  -- NOTE since we are forcing braces on 'sepSemi' based on 'ob', we have to+  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to   -- restore the brace state inside the sepsemi.   ub <- bool dontUseBraces useBraces <$> canUseBraces   ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts)@@ -167,8 +169,8 @@   GRHSs GhcPs (Located body) ->   R () p_match' placer render style isInfix strictness m_pats GRHSs {..} = do-  -- NOTE Normally, since patterns may be placed in a multi-line layout, it-  -- is necessary to bump indentation for the pattern group so it's more+  -- Normally, since patterns may be placed in a multi-line layout, it is+  -- necessary to bump indentation for the pattern group so it's more   -- indented than function name. This in turn means that indentation for   -- the body should also be bumped. Normally this would mean that bodies   -- would start with two indentation steps applied, which is ugly, so we@@ -390,14 +392,14 @@     space     sitcc $ located binds p_hsLocalBinds   ParStmt {} ->-    -- NOTE 'ParStmt' should always be eliminated in 'gatherStmt' already,-    -- such that it never occurs in 'p_stmt''. Consequently, handling it-    -- here would be redundant.+    -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such+    -- that it never occurs in 'p_stmt''. Consequently, handling it here+    -- would be redundant.     notImplemented "ParStmt"   TransStmt {..} ->-    -- NOTE 'TransStmt' only needs to account for render printing itself,-    -- since pretty printing of relevant statements (e.g., in 'trS_stmts')-    -- is handled through 'gatherStmt'.+    -- 'TransStmt' only needs to account for render printing itself, since+    -- pretty printing of relevant statements (e.g., in 'trS_stmts') is+    -- handled through 'gatherStmt'.     case (trS_form, trS_by) of       (ThenForm, Nothing) -> do         txt "then"@@ -457,7 +459,7 @@         markInit [] = []         markInit [x] = [(False, x)]         markInit (x : xs) = (True, x) : markInit xs-    -- NOTE When in a single-line layout, there is a chance that the inner+    -- When in a single-line layout, there is a chance that the inner     -- elements will also contain semicolons and they will confuse the     -- parser. so we request braces around every element except the last.     br <- layoutToBraces <$> getLayout@@ -540,8 +542,10 @@         -- We need to handle the last argument specially if it is a         -- hanging construct, so separate it from the rest.         (initp, lastp) = (NE.init args, NE.last args)-        initSpan = combineSrcSpans' $ getLoc f :| map getLoc initp-        -- Hang the last argument only if the initial arguments spans one+        initSpan =+          combineSrcSpans' $+            getLoc f :| [(srcLocSpan . srcSpanStart . getLoc) lastp]+        -- Hang the last argument only if the initial arguments span one         -- line.         placement =           if isOneLineSpan initSpan@@ -561,11 +565,16 @@             indent =               case func of                 L _ (HsPar NoExt _) -> inci+                L _ (HsAppType NoExt _ _) -> inci+                L _ (HsMultiIf NoExt _) -> inci                 L spn _ ->                   if isOneLineSpan spn                     then inci                     else id-        useBraces $ do+        ub <- getLayout <&> \case+          SingleLine -> useBraces+          MultiLine -> id+        ub $ do           located func (p_hsExpr' s)           breakpoint           indent $ sep breakpoint (located' p_hsExpr) initp@@ -600,7 +609,9 @@     inci (located op p_hsExpr)   SectionR NoExt op x -> do     located op p_hsExpr-    breakpoint+    useRecordDot' <- useRecordDot+    let isRecordDot' = isRecordDot (unLoc op) (getLoc x)+    unless (useRecordDot' && isRecordDot') breakpoint     inci (located x p_hsExpr)   ExplicitTuple NoExt args boxity -> do     let isSection = any (isMissing . unLoc) args@@ -625,9 +636,8 @@   HsIf NoExt _ if' then' else' ->     p_if exprPlacement p_hsExpr if' then' else'   HsMultiIf NoExt guards -> do-    txt "if"-    breakpoint-    inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards+    txt "if "+    inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards   HsLet NoExt localBinds e ->     p_let p_hsExpr localBinds e   HsDo NoExt ctx es -> do@@ -1012,8 +1022,8 @@     txt "["     p_rdrName (L srcSpan quoterName)     txt "|"-    -- NOTE QuasiQuoters often rely on precise custom strings. We cannot do-    -- any formatting here without potentially breaking someone's code.+    -- QuasiQuoters often rely on precise custom strings. We cannot do any+    -- formatting here without potentially breaking someone's code.     atom str     txt "|]"   HsSpliced {} -> notImplemented "HsSpliced"@@ -1204,7 +1214,6 @@   HsCase NoExt _ _ -> Hanging   HsDo NoExt DoExpr _ -> Hanging   HsDo NoExt MDoExpr _ -> Hanging-  RecordCon NoExt _ _ -> Hanging   -- If the rightmost expression in an operator chain is hanging, make the   -- whole block hanging; so that we can use the common @f = foo $ do@   -- style.@@ -1248,9 +1257,9 @@   R () p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s) p_exprOpTree isDollarSpecial s (OpBranch x op y) = do-  -- NOTE If the beginning of the first argument and the second argument-  -- are on the same line, and the second argument has a hanging form, use-  -- hanging placement.+  -- If the beginning of the first argument and the second argument are on+  -- the same line, and the second argument has a hanging form, use hanging+  -- placement.   let placement =         if isOneLineSpan           (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))@@ -1275,19 +1284,53 @@           p_exprOpTree (not gotDollar) s x   let p_op = located op (opWrapper . p_hsExpr)       p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)-  if isDollarSpecial && gotDollar && placement == Normal && isOneLineSpan (opTreeLoc x)+      isSection = case (opTreeLoc x, getLoc op) of+        (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->+          srcSpanEndCol treeSpan /= srcSpanStartCol opSpan+        _ -> False+  useRecordDot' <- useRecordDot+  let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)+  if useRecordDot' && isRecordDot'     then do-      useBraces lhs-      space+      lhs+      when isSection space       p_op-      breakpoint-      inci p_y-    else do-      ub lhs-      placeHanging placement $ do-        p_op-        space-        p_y+      p_y+    else+      if isDollarSpecial+        && gotDollar+        && placement+        == Normal+        && isOneLineSpan (opTreeLoc x)+        then do+          useBraces lhs+          space+          p_op+          breakpoint+          inci p_y+        else do+          ub lhs+          placeHanging placement $ do+            p_op+            space+            p_y++-- | Return 'True' if given expression is a record-dot operator expression.+isRecordDot ::+  -- | Operator expression+  HsExpr GhcPs ->+  -- | Span of the expression on the right-hand side of the operator+  SrcSpan ->+  Bool+isRecordDot op (RealSrcSpan ySpan) = case op of+  HsVar NoExt (L (RealSrcSpan opSpan) opName) ->+    isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)+  _ -> False+isRecordDot _ _ = False++-- | Check whether a given 'RdrName' is the dot operator.+isDot :: RdrName -> Bool+isDot name = rdrNameOcc name == mkVarOcc "."  -- | Get annotations for the enclosing element. getEnclosingAnns :: R [AnnKeywordId]

@@ -30,9 +30,9 @@   ParsedSource ->   R () p_hsModule shebangs pragmas (L moduleSpan HsModule {..}) = do-  -- NOTE If span of exports in multiline, the whole thing is multiline.-  -- This is especially important because span of module itself always seems-  -- to have length zero, so it's not reliable for layout selection.+  -- If span of exports in multiline, the whole thing is multiline. This is+  -- especially important because span of module itself always seems to have+  -- length zero, so it's not reliable for layout selection.   let exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports       deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage       spans' = exportSpans ++ deprecSpan ++ [moduleSpan]

@@ -17,6 +17,7 @@ import Data.Ord (Down (Down), comparing) import GHC import OccName (mkVarOcc)+import Ormolu.Utils (unSrcSpan) import RdrName (mkRdrUnqual) import SrcLoc (combineSrcSpans) @@ -171,8 +172,6 @@               maybe 0 srcSpanStartCol (unSrcSpan o),               go r             ]-    unSrcSpan (RealSrcSpan r) = Just r-    unSrcSpan (UnhelpfulSpan _) = Nothing  ---------------------------------------------------------------------------- -- Helpers

@@ -9,12 +9,16 @@     showOutputable,     splitDocString,     typeArgToType,+    unSrcSpan,+    separatedByBlank,   ) where  import Data.Data (Data, showConstr, toConstr) import Data.List (dropWhileEnd)+import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import GHC@@ -79,3 +83,15 @@   HsValArg tm -> tm   HsTypeArg _ ty -> ty   HsArgPar _ -> notImplemented "HsArgPar"++unSrcSpan :: SrcSpan -> Maybe RealSrcSpan+unSrcSpan (RealSrcSpan r) = Just r+unSrcSpan (UnhelpfulSpan _) = Nothing++-- | Do two declaration groups have a blank between them?+separatedByBlank :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool+separatedByBlank loc a b =+  fromMaybe False $ do+    endA <- srcSpanEndLine <$> unSrcSpan (loc $ NE.last a)+    startB <- srcSpanStartLine <$> unSrcSpan (loc $ NE.head b)+    pure (startB - endA >= 2)