ormolu 0.0.5.0 → 0.1.0.0

raw patch · 87 files changed

+878/−668 lines, 87 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +43/−0
• CONTRIBUTING.md +1/−1
• DESIGN.md +11/−11
• README.md +10/−3
• app/Main.hs +4/−2
• data/examples/declaration/data/gadt/multiline-out.hs +1/−1
• data/examples/declaration/data/multiline-arg-parens-out.hs +1/−1
• data/examples/declaration/data/partly-documented-out.hs +5/−0
• data/examples/declaration/data/partly-documented.hs +2/−0
• data/examples/declaration/data/unnamed-field-comment-0-out.hs +7/−0
• data/examples/declaration/data/unnamed-field-comment-0.hs +5/−0
• data/examples/declaration/data/unnamed-field-comment-1-out.hs +5/−0
• data/examples/declaration/data/unnamed-field-comment-1.hs +4/−0
• data/examples/declaration/data/with-comment-out.hs +4/−0
• data/examples/declaration/data/with-comment.hs +5/−0
• data/examples/declaration/data/with-weird-haddock-out.hs +4/−0
• data/examples/declaration/data/with-weird-haddock.hs +2/−0
• data/examples/declaration/signature/type/multi-value-out.hs +5/−0
• data/examples/declaration/signature/type/multi-value.hs +5/−0
• data/examples/declaration/type-synonyms/with-weird-haddock-out.hs +3/−0
• data/examples/declaration/type-synonyms/with-weird-haddock.hs +1/−0
• data/examples/declaration/value/function/arrow/proc-do-complex-out.hs +1/−1
• data/examples/declaration/value/function/awkward-comment-0-out.hs +6/−0
• data/examples/declaration/value/function/awkward-comment-0.hs +5/−0
• data/examples/declaration/value/function/awkward-comment-1-out.hs +9/−0
• data/examples/declaration/value/function/awkward-comment-1.hs +7/−0
• data/examples/declaration/value/function/if-with-comment-out.hs +8/−0
• data/examples/declaration/value/function/if-with-comment.hs +8/−0
• data/examples/declaration/value/function/multi-way-if-out.hs +4/−2
• data/examples/declaration/value/function/operator-comments-2-out.hs +5/−0
• data/examples/declaration/value/function/operator-comments-2.hs +4/−0
• data/examples/declaration/value/function/operators-0-out.hs +5/−0
• data/examples/declaration/value/function/operators-0.hs +4/−0
• data/examples/declaration/value/function/operators-1-out.hs +4/−0
• data/examples/declaration/value/function/operators-1.hs +3/−0
• data/examples/declaration/value/function/operators-2-out.hs +4/−0
• data/examples/declaration/value/function/operators-2.hs +4/−0
• data/examples/declaration/value/function/operators-3-out.hs +3/−0
• data/examples/declaration/value/function/operators-3.hs +3/−0
• data/examples/declaration/value/function/operators-4-out.hs +3/−0
• data/examples/declaration/value/function/operators-4.hs +3/−0
• data/examples/declaration/value/function/operators-5-out.hs +5/−0
• data/examples/declaration/value/function/operators-5.hs +4/−0
• data/examples/declaration/value/function/operators-6-out.hs +9/−0
• data/examples/declaration/value/function/operators-6.hs +7/−0
• data/examples/declaration/value/function/operators-out.hs +0/−5
• data/examples/declaration/value/function/operators.hs +0/−4
• data/examples/declaration/value/function/record-constructors-out.hs +0/−31
• data/examples/declaration/value/function/record-constructors.hs +0/−22
• data/examples/declaration/value/function/record-dot-out.hs +0/−15
• data/examples/declaration/value/function/record-dot.hs +0/−14
• data/examples/declaration/value/function/record-inter-comments-out.hs +0/−13
• data/examples/declaration/value/function/record-inter-comments.hs +0/−11
• data/examples/declaration/value/function/record-updaters-out.hs +0/−11
• data/examples/declaration/value/function/record-updaters.hs +0/−7
• data/examples/declaration/value/function/record-wildcards-out.hs +0/−14
• data/examples/declaration/value/function/record-wildcards.hs +0/−13
• data/examples/other/comment-two-blocks-out.hs +2/−2
• data/examples/other/inline-comment-0-out.hs +3/−0
• data/examples/other/inline-comment-0.hs +3/−0
• data/examples/other/inline-comment-1-out.hs +12/−0
• data/examples/other/inline-comment-1.hs +9/−0
• data/examples/other/multiple-blank-line-comment-out.hs +9/−0
• data/examples/other/multiple-blank-line-comment.hs +10/−0
• ormolu.cabal +173/−160
• src/GHC.hs +0/−3
• src/Ormolu.hs +2/−2
• src/Ormolu/Config.hs +2/−2
• src/Ormolu/Diff.hs +14/−11
• src/Ormolu/Parser.hs +3/−3
• src/Ormolu/Parser/CommentStream.hs +107/−58
• src/Ormolu/Parser/Result.hs +1/−1
• src/Ormolu/Printer/Combinators.hs +11/−19
• src/Ormolu/Printer/Comments.hs +41/−51
• src/Ormolu/Printer/Internal.hs +83/−52
• src/Ormolu/Printer/Meat/Common.hs +5/−4
• src/Ormolu/Printer/Meat/Declaration/Data.hs +16/−6
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +9/−4
• src/Ormolu/Printer/Meat/Declaration/Type.hs +4/−2
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +2/−2
• src/Ormolu/Printer/Meat/Declaration/Value.hs +32/−27
• src/Ormolu/Printer/Meat/Module.hs +2/−2
• src/Ormolu/Printer/Meat/Type.hs +24/−9
• src/Ormolu/Printer/Operators.hs +43/−56
• src/Ormolu/Utils.hs +6/−6
• tests/Ormolu/PrinterSpec.hs +3/−3

@@ -1,3 +1,46 @@+## Ormolu 0.1.0.0++* Fixed rendering of type signatures concerning several identifiers. [Issue+  566](https://github.com/tweag/ormolu/issues/566).++* Fixed an idempotence issue with inline comments in tuples and parentheses.+  [Issue 450](https://github.com/tweag/ormolu/issues/450).++* Fixed an idempotence issue when certain comments where picked up as+  “continuation” of a series of comments [Issue+  449](https://github.com/tweag/ormolu/issues/449).++* Fixed an idempotence issue related to different indentation levels in a+  comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512).++* Fixed an idempotence issue related to comments which may happen to be+  separated from the elements they are attached to by the equality sign.+  [Issue 340](https://github.com/tweag/ormolu/issues/340).++* Fixed an idempotence issue with type synonym and data declarations where+  the type has a Haddock. [Issue+  578](https://github.com/tweag/ormolu/issues/578).++* Fix the false positive about AST differences in presence of comments with+  multiple blank lines in a row. [Issue+  518](https://github.com/tweag/ormolu/issues/518).++* Fixed rendering of comment around if expressions. [Issue+  458](https://github.com/tweag/ormolu/issues/458).++* Unnamed fields of data constructors are now documented using the `-- ^`+  syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue+  428](https://github.com/tweag/ormolu/issues/428).++* Fixed non-idempotent transformation of partly documented data definition.+  [Issue 590](https://github.com/tweag/ormolu/issues/590).++* Fixed an idempotence issue related to operators. [Issue+  522](https://github.com/tweag/ormolu/issues/522).++* Renamed the `--check-idempotency` flag to `--check-idempotence`.+  Apparently only the latter is correct.+ ## Ormolu 0.0.5.0  * Grouping of statements in `do`-blocks is now preserved. [Issue

@@ -30,7 +30,7 @@ * The result of printing is parsed back again and the AST is compared to the   AST obtained from the original file. They should match. * The output of printer is checked against the expected output.-* Idempotency property is verified: formatting already formatted code+* Idempotence property is verified: formatting already formatted code   results in exactly the same output.  Examples can be organized in sub-directories, see the existing ones for

@@ -24,7 +24,7 @@  We set for the following goals (mostly taken from [brittany](https://github.com/lspitzner/brittany)):-* Preserve the meaning of the formatted functions;+* Preserve the meaning of the formatted functions when no CPP is used; * Make reasonable use of screen space; * Use linear space and computation time on the size of the input; * Preserve comments;@@ -140,8 +140,10 @@  ### CPP -Formatting a module which uses CPP directives won't be supported. Instead,-we hope for a solution to replace CPP to do conditional compilation.+We allow CPP directives in the input, but we forgo the goal to preserve the+meaning of the formatted functions in that case.+Instead of supporting CPP better, we hope for a solution to replace CPP to+do conditional compilation.  There are the following challenges when formatting a module with CPP: @@ -180,14 +182,15 @@ ```  At the time of this writing, formatting this program with Hindent-produces the same output we would get if the CPP directives were-considered comments:+or Ormolu produces the same output we would get if the CPP directives+were considered comments:  ```-$ hindent --version-hindent 5.2.7+$ ormolu --version+ormolu 0.0.5.0 HEAD fc64eada5c4da7a5b07d2872e253671b48aec115+using ghc-lib-parser 8.10.1.20200412 -$ hindent test.hs+$ ormolu --mode inplace test.hs  $ cat test.hs {-# LANGUAGE CPP #-}@@ -226,9 +229,6 @@ to parse Haskell modules. If CPP is replaced with some language extension or mechanism to do conditional compilation, all tools will benefit from it.--Therefore, CPP won't be supported. If the CPP extension-is enabled, we should signal an error right away.  ### Printing 

@@ -91,6 +91,12 @@ $ ormolu --mode inplace Module.hs ``` +Use `find` to format a tree recursively:++```console+$ ormolu --mode inplace $(find . -name '*.hs')+```+ ## Magic comments  Ormolu understands two magic comments:@@ -116,8 +122,9 @@  * CPP support is experimental. CPP is virtually impossible to handle   correctly, so we process them as a sort of unchangeable snippets. This-  works only in simple cases when CPP conditionals are self-contained. Use-  Ormolu with CPP at your own risk.+  works only in simple cases when CPP conditionals surround top-level+  declarations. See the [CPP][design-cpp] section in the design notes for+  a discussion of the dangers. * Input modules should be parsable by Haddock, which is a bit stricter   criterion than just being valid Haskell modules. * Various minor idempotence issues, most of them are related to comments.@@ -154,7 +161,7 @@  Copyright © 2018–present Tweag I/O -[design]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp+[design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp [contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md [license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md [haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts

@@ -167,17 +167,19 @@         help "Output information useful for debugging"       ]     <*> (switch . mconcat)-      [ long "check-idempotency",+      [ long "check-idempotence",         short 'c',         help "Fail if formatting is not idempotent"       ]     <*> ( RegionIndices             <$> (optional . option auto . mconcat)               [ long "start-line",-                help "Start line of the region to format (lines start from 1)"+                metavar "START",+                help "Start line of the region to format (starts from 1)"               ]             <*> (optional . option auto . mconcat)               [ long "end-line",+                metavar "END",                 help "End line of the region to format (inclusive)"               ]         )

@@ -8,7 +8,7 @@   Foo ::     forall a b.     (Show a, Eq b) => -- foo-      -- bar+    -- bar     a ->     b ->     Foo 'Int

@@ -5,6 +5,6 @@   = Foo       Bar       (Set Baz) -- and here we go-        -- and that's it+      -- and that's it       Text   deriving (Eq)

@@ -0,0 +1,5 @@+data Optimisation+  = PETransform+  | -- | partial eval and associated transforms+    GeneralisedNatHack+  deriving (Show, Eq, Generic)

@@ -0,0 +1,2 @@+data Optimisation = PETransform | GeneralisedNatHack -- ^ partial eval and associated transforms+  deriving (Show, Eq, Generic)

@@ -0,0 +1,7 @@+data Foo+  = -- | Bar+    Bar+      Field1+      -- ^ Field 1+      Field2+      -- ^ Field 2

@@ -0,0 +1,5 @@+data Foo+  = -- | Bar+    Bar+      Field1 -- ^ Field 1+      Field2 -- ^ Field 2

@@ -0,0 +1,5 @@+data X+  = B+      !Int+      -- ^ y+      C

@@ -0,0 +1,4 @@+data X+  = B+     !Int -- ^ y+     C

@@ -0,0 +1,4 @@+data A+  = B -- C+  | -- D+    E

@@ -0,0 +1,5 @@+data A =+     B  -- C++   -- D+   | E

@@ -0,0 +1,4 @@+data PlusLevel' t+  = -- | @n + ℓ@.+    Plus Integer (LevelAtom' t)+  deriving (Show, Data)

@@ -0,0 +1,2 @@+data PlusLevel' t = Plus Integer (LevelAtom' t)  -- ^ @n + ℓ@.+  deriving (Show, Data)

@@ -2,6 +2,11 @@ foo = 1 bar = 2 +a, b, c :: Int+a = 1+b = 2+c = 3+ foo,   bar,   baz ::

@@ -2,6 +2,11 @@ foo = 1 bar = 2 +a, b, c :: Int+a = 1+b = 2+c = 3+ foo,   bar,     baz :: Int

@@ -0,0 +1,3 @@+type Elims =+  -- | eliminations ordered left-to-right.+  [Elim]

@@ -0,0 +1,1 @@+type Elims = [Elim]  -- ^ eliminations ordered left-to-right.

@@ -40,7 +40,7 @@                   )         else do           let u = x -- Let bindings bind expressions, not commands-            -- Could pattern match directly on x+          -- Could pattern match directly on x           i <- case u of             0 -> (g . h -< u)             n ->

@@ -0,0 +1,6 @@+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+  =+  case reply of+    Ok x state err2 -> Ok x state (mergeError err1 err2)+    Error err2 -> Error (mergeError err1 err2)

@@ -0,0 +1,5 @@+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+    = case reply of+        Ok x state err2 -> Ok x state (mergeError err1 err2)+        Error err2      -> Error (mergeError err1 err2)

@@ -0,0 +1,9 @@+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp+doForeign x = x+  where+    splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits+      =+      do+        let l' = toFDesc l+        r' <- irTerm (sMN 0 "__foreignCall") vs env r+        return (l', r')

@@ -0,0 +1,7 @@+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp+doForeign x = x+  where+    splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits+        = do let l' = toFDesc l+             r' <- irTerm (sMN 0 "__foreignCall") vs env r+             return (l', r')

@@ -0,0 +1,8 @@+foo =+  if undefined+    then -- then comment+      undefined+    else -- else comment++    do+      undefined

@@ -0,0 +1,8 @@+foo =+  if undefined+    -- then comment+    then undefined+    -- else comment+    else+      do+        undefined

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

@@ -0,0 +1,5 @@+x =+  y+    ++ f g -- commentA+    -- commentB+    -- commentC

@@ -0,0 +1,4 @@+x  =+      y ++ -- commentA+-- commentB+      f g -- commentC

@@ -0,0 +1,5 @@+a =+  b & c .~ d+    & e+      %~ f+        g

@@ -0,0 +1,4 @@+a =+  b & c .~ d+    & e %~ f+            g

@@ -0,0 +1,4 @@+foo =+  f+    . g+    =<< h . i

@@ -0,0 +1,3 @@+foo = f+    . g+  =<< h . i

@@ -0,0 +1,4 @@+foo n+  | x || y && z || n ** x+      || x && n =+    42

@@ -0,0 +1,4 @@+foo n+  | x || y && z || n ** x+      || x && n =+        42

@@ -0,0 +1,3 @@+foo =+  op <> n <+> colon <+> prettySe <+> text "="+    <+> prettySe <> text sc

@@ -0,0 +1,3 @@+foo =+  op <> n <+> colon <+> prettySe <+> text "=" <+>+    prettySe <> text sc

@@ -0,0 +1,3 @@+foo =+  line <> bindingOf <+> text "=" <+> tPretty <+> colon+    <+> align <> prettyPs

@@ -0,0 +1,3 @@+foo =+  line <> bindingOf <+> text "=" <+> tPretty <+> colon <+>+    align <> prettyPs

@@ -0,0 +1,5 @@+foo =+  map bar $+    [ baz+    ]+      ++ quux

@@ -0,0 +1,4 @@+foo =+  map bar $+    [ baz+    ] ++ quux

@@ -0,0 +1,9 @@+type PermuteRef =+  "a"+    :> ( "b" :> "c" :> End+           :<|> "c" :> "b" :> End+       )+    :<|> "b"+      :> ( "a" :> "c" :> End+             :<|> "c" :> "a" :> End+         )

@@ -0,0 +1,7 @@+type PermuteRef =+       "a" :> (    "b" :> "c" :> End+              :<|> "c" :> "b" :> End+              )+  :<|> "b" :> (    "a" :> "c" :> End+              :<|> "c" :> "a" :> End+              )

@@ -1,5 +0,0 @@-a =-  b & c .~ d-    & e-      %~ f-        g

@@ -1,4 +0,0 @@-a =-  b & c .~ d-    & e %~ f-            g

@@ -1,31 +0,0 @@-foo = Foo {a = 3}--bar =-  Bar-    { abc = foo,-      def = Foo {a = 10}-    }--baz = Baz {}--sym = Foo {(+) = 3}--aLongVariableName =-  ALongRecordName-    { short = baz,-      aLongRecordFieldName =-        YetAnotherLongRecordName-          { yetAnotherLongRecordFieldName = "a long string"-          },-      aLongRecordFieldName2 =-        Just-          YetAnotherLongRecordName-            { yetAnotherLongRecordFieldName = "a long string",-              yetAnotherLongRecordFieldName =-                Just-                  "a long string"-            },-      aLongRecordFieldName3 = do-        foo-        bar-    }

@@ -1,22 +0,0 @@-foo = Foo { a = 3 }-bar = Bar {-    abc = foo,-    def = Foo {a = 10}-}-baz = Baz{ }-sym = Foo { (+) = 3 }-aLongVariableName =-  ALongRecordName-    { short = baz,-      aLongRecordFieldName = YetAnotherLongRecordName-        { yetAnotherLongRecordFieldName = "a long string"-          },-      aLongRecordFieldName2 = Just YetAnotherLongRecordName-                                 { yetAnotherLongRecordFieldName = "a long string",-                                   yetAnotherLongRecordFieldName = Just-                                                                     "a long string"-                                   },-      aLongRecordFieldName3 = do-                               foo-                               bar-      }

@@ -1,15 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}--data Foo = Foo {bar :: Int}--mfoo = fmap (.bar) $ Nothing--bar = (Foo 1).bar--fooplus f n = f{foo = f.bar + n}--fooplus' f n = f {foo = f.bar + n}--fooplus'' f n = f {foo = f.bar + n}--fooplus''' f n = f {foo = f.bar + n}

@@ -1,14 +0,0 @@-{-# OPTIONS_GHC -fplugin=RecordDotPreprocessor #-}-data Foo = Foo { bar :: Int }--mfoo = fmap (.bar)   $ Nothing--bar = (  Foo 1).bar--fooplus f n = f{foo = f.bar + n}--fooplus' f n = f { foo = f.bar + n}--fooplus'' f n = f {foo = f.bar + n}--fooplus''' f n = f{ foo = f.bar + n}

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

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

@@ -1,11 +0,0 @@-foo x = x {a = 3}--bar x =-  x-    { abc = foo,-      def = Foo {a = 10}-    }--baz x = x {}--sym x = x {(+) = 4}

@@ -1,7 +0,0 @@-foo x = x { a = 3 }-bar x = x {-    abc = foo,-    def = Foo {a = 10}-}-baz x = x{ }-sym x = x { (+) = 4 }

@@ -1,14 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}--foo x y = Foo {x, y}--bar x y z =-  Bar-    { x,-      y,-      z,-      ..-    }--baz = Baz {..}

@@ -1,13 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE RecordWildCards #-}--foo x y = Foo { x, y }--bar x y z = Bar {-    x,-    y,-    z,-    ..-}--baz = Baz { .. }

@@ -2,7 +2,7 @@ newNames =   let (*) = flip (,)    in [ "Control" * "Monad"-        -- Foo+  -- Foo -        -- Bar+  -- Bar       ]

@@ -0,0 +1,3 @@+x = ({-a-} b, c)++y = ({-a-} b)

@@ -0,0 +1,3 @@+x = ({-a-}b, c)++y = ({-a-}b)

@@ -0,0 +1,12 @@+showPs env ((n, _, Let _ t v) : bs) =+  "  " ++ show n ++ " : "+    ++ showEnv env ({- normalise ctxt env -} t)+    ++ "   =   "+    ++ showEnv env ({- normalise ctxt env -} v)+    ++ "\n"+    ++ showPs env bs+showPs env ((n, _, b) : bs) =+  "  " ++ show n ++ " : "+    ++ showEnv env ({- normalise ctxt env -} (binderTy b))+    ++ "\n"+    ++ showPs env bs

@@ -0,0 +1,9 @@+showPs env ((n, _, Let _ t v):bs)+    = "  " ++ show n ++ " : " +++      showEnv env ({- normalise ctxt env -} t) ++ "   =   " +++      showEnv env ({- normalise ctxt env -} v) +++      "\n" ++ showPs env bs+showPs env ((n, _, b):bs)+    = "  " ++ show n ++ " : " +++      showEnv env ({- normalise ctxt env -} (binderTy b)) +++      "\n" ++ showPs env bs

@@ -0,0 +1,9 @@+module A where++a =+  b+    [ f+    {-,++                                       -}+    ]

@@ -0,0 +1,10 @@+module A where++a =+  b+    [ f+ {-,+++                                    -}+    ]

@@ -1,170 +1,183 @@-name:                 ormolu-version:              0.0.5.0-cabal-version:        1.18-tested-with:          GHC==8.6.5, GHC==8.8.3, GHC==8.10.1-license:              BSD3-license-file:         LICENSE.md-maintainer:           Mark Karpov <mark.karpov@tweag.io>-homepage:             https://github.com/tweag/ormolu-bug-reports:          https://github.com/tweag/ormolu/issues-category:             Development, Formatting-synopsis:             A formatter for Haskell source code-build-type:           Simple-description:          A formatter for Haskell source code.-extra-doc-files:      CONTRIBUTING.md-                    , CHANGELOG.md-                    , DESIGN.md-                    , README.md-data-files:           data/examples/declaration/annotation/*.hs-                    , data/examples/declaration/class/*.hs-                    , data/examples/declaration/data/*.hs-                    , data/examples/declaration/data/gadt/*.hs-                    , data/examples/declaration/default/*.hs-                    , data/examples/declaration/deriving/*.hs-                    , data/examples/declaration/foreign/*.hs-                    , data/examples/declaration/instance/*.hs-                    , data/examples/declaration/rewrite-rule/*.hs-                    , data/examples/declaration/role-annotation/*.hs-                    , data/examples/declaration/signature/complete/*.hs-                    , data/examples/declaration/signature/fixity/*.hs-                    , data/examples/declaration/signature/inline/*.hs-                    , data/examples/declaration/signature/minimal/*.hs-                    , data/examples/declaration/signature/pattern/*.hs-                    , data/examples/declaration/signature/set-cost-centre/*.hs-                    , data/examples/declaration/signature/specialize/*.hs-                    , data/examples/declaration/signature/type/*.hs-                    , data/examples/declaration/splice/*.hs-                    , data/examples/declaration/type-families/closed-type-family/*.hs-                    , data/examples/declaration/type-families/data-family/*.hs-                    , data/examples/declaration/type-families/type-family/*.hs-                    , data/examples/declaration/type-synonyms/*.hs-                    , data/examples/declaration/type/*.hs-                    , data/examples/declaration/value/function/*.hs-                    , data/examples/declaration/value/function/arrow/*.hs-                    , data/examples/declaration/value/function/comprehension/*.hs-                    , data/examples/declaration/value/function/do/*.hs-                    , data/examples/declaration/value/function/infix/*.hs-                    , data/examples/declaration/value/function/pattern/*.hs-                    , data/examples/declaration/value/other/*.hs-                    , data/examples/declaration/value/pattern-synonyms/*.hs-                    , data/examples/declaration/warning/*.hs-                    , data/examples/import/*.hs-                    , data/examples/module-header/*.hs-                    , data/examples/other/*.hs+cabal-version:   1.18+name:            ormolu+version:         0.1.0.0+license:         BSD3+license-file:    LICENSE.md+maintainer:      Mark Karpov <mark.karpov@tweag.io>+tested-with:     ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1+homepage:        https://github.com/tweag/ormolu+bug-reports:     https://github.com/tweag/ormolu/issues+synopsis:        A formatter for Haskell source code+description:     A formatter for Haskell source code.+category:        Development, Formatting+build-type:      Simple+data-files:+    data/examples/declaration/annotation/*.hs+    data/examples/declaration/class/*.hs+    data/examples/declaration/data/*.hs+    data/examples/declaration/data/gadt/*.hs+    data/examples/declaration/default/*.hs+    data/examples/declaration/deriving/*.hs+    data/examples/declaration/foreign/*.hs+    data/examples/declaration/instance/*.hs+    data/examples/declaration/rewrite-rule/*.hs+    data/examples/declaration/role-annotation/*.hs+    data/examples/declaration/signature/complete/*.hs+    data/examples/declaration/signature/fixity/*.hs+    data/examples/declaration/signature/inline/*.hs+    data/examples/declaration/signature/minimal/*.hs+    data/examples/declaration/signature/pattern/*.hs+    data/examples/declaration/signature/set-cost-centre/*.hs+    data/examples/declaration/signature/specialize/*.hs+    data/examples/declaration/signature/type/*.hs+    data/examples/declaration/splice/*.hs+    data/examples/declaration/type-families/closed-type-family/*.hs+    data/examples/declaration/type-families/data-family/*.hs+    data/examples/declaration/type-families/type-family/*.hs+    data/examples/declaration/type-synonyms/*.hs+    data/examples/declaration/type/*.hs+    data/examples/declaration/value/function/*.hs+    data/examples/declaration/value/function/arrow/*.hs+    data/examples/declaration/value/function/comprehension/*.hs+    data/examples/declaration/value/function/do/*.hs+    data/examples/declaration/value/function/infix/*.hs+    data/examples/declaration/value/function/pattern/*.hs+    data/examples/declaration/value/other/*.hs+    data/examples/declaration/value/pattern-synonyms/*.hs+    data/examples/declaration/warning/*.hs+    data/examples/import/*.hs+    data/examples/module-header/*.hs+    data/examples/other/*.hs +extra-doc-files:+    CONTRIBUTING.md+    CHANGELOG.md+    DESIGN.md+    README.md+ source-repository head-  type:               git-  location:           https://github.com/tweag/ormolu.git+    type:     git+    location: https://github.com/tweag/ormolu.git  flag dev-  description:        Turn on development settings.-  manual:             True-  default:            False+    description: Turn on development settings.+    default:     False+    manual:      True  library-  hs-source-dirs:     src-  build-depends:      base           >= 4.12 && < 5.0-                    , bytestring     >= 0.2 && < 0.11-                    , containers     >= 0.5 && < 0.7-                    , dlist          >= 0.8 && < 0.9-                    , exceptions     >= 0.6 && < 0.11-                    , ghc-lib-parser >= 8.10 && < 8.11-                    , mtl            >= 2.0 && < 3.0-                    , syb            >= 0.7 && < 0.8-                    , text           >= 0.2 && < 1.3-  exposed-modules:    Ormolu-                    , Ormolu.Config-                    , Ormolu.Diff-                    , Ormolu.Exception-                    , Ormolu.Imports-                    , Ormolu.Parser-                    , Ormolu.Parser.Anns-                    , Ormolu.Parser.CommentStream-                    , Ormolu.Parser.Pragma-                    , Ormolu.Parser.Result-                    , Ormolu.Parser.Shebang-                    , Ormolu.Printer-                    , Ormolu.Printer.Combinators-                    , Ormolu.Printer.Comments-                    , Ormolu.Printer.Internal-                    , Ormolu.Printer.Meat.Common-                    , Ormolu.Printer.Meat.Declaration-                    , Ormolu.Printer.Meat.Declaration.Annotation-                    , Ormolu.Printer.Meat.Declaration.Class-                    , Ormolu.Printer.Meat.Declaration.Data-                    , Ormolu.Printer.Meat.Declaration.Default-                    , Ormolu.Printer.Meat.Declaration.Foreign-                    , Ormolu.Printer.Meat.Declaration.Instance-                    , Ormolu.Printer.Meat.Declaration.RoleAnnotation-                    , Ormolu.Printer.Meat.Declaration.Rule-                    , Ormolu.Printer.Meat.Declaration.Signature-                    , Ormolu.Printer.Meat.Declaration.Splice-                    , Ormolu.Printer.Meat.Declaration.Type-                    , Ormolu.Printer.Meat.Declaration.TypeFamily-                    , Ormolu.Printer.Meat.Declaration.Value-                    , Ormolu.Printer.Meat.Declaration.Warning-                    , Ormolu.Printer.Meat.ImportExport-                    , Ormolu.Printer.Meat.Module-                    , Ormolu.Printer.Meat.Pragma-                    , Ormolu.Printer.Meat.Type-                    , Ormolu.Printer.Operators-                    , Ormolu.Printer.SpanStream-                    , Ormolu.Processing.Common-                    , Ormolu.Processing.Cpp-                    , Ormolu.Processing.Postprocess-                    , Ormolu.Processing.Preprocess-                    , Ormolu.Utils-  other-modules:      GHC-                    , GHC.DynFlags-  if flag(dev)-    ghc-options:      -Wall -Werror -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-                      -- https://github.com/haskell/haddock/issues/1116-                      -Wno-missing-home-modules-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    exposed-modules:+        Ormolu+        Ormolu.Config+        Ormolu.Diff+        Ormolu.Exception+        Ormolu.Imports+        Ormolu.Parser+        Ormolu.Parser.Anns+        Ormolu.Parser.CommentStream+        Ormolu.Parser.Pragma+        Ormolu.Parser.Result+        Ormolu.Parser.Shebang+        Ormolu.Printer+        Ormolu.Printer.Combinators+        Ormolu.Printer.Comments+        Ormolu.Printer.Internal+        Ormolu.Printer.Meat.Common+        Ormolu.Printer.Meat.Declaration+        Ormolu.Printer.Meat.Declaration.Annotation+        Ormolu.Printer.Meat.Declaration.Class+        Ormolu.Printer.Meat.Declaration.Data+        Ormolu.Printer.Meat.Declaration.Default+        Ormolu.Printer.Meat.Declaration.Foreign+        Ormolu.Printer.Meat.Declaration.Instance+        Ormolu.Printer.Meat.Declaration.RoleAnnotation+        Ormolu.Printer.Meat.Declaration.Rule+        Ormolu.Printer.Meat.Declaration.Signature+        Ormolu.Printer.Meat.Declaration.Splice+        Ormolu.Printer.Meat.Declaration.Type+        Ormolu.Printer.Meat.Declaration.TypeFamily+        Ormolu.Printer.Meat.Declaration.Value+        Ormolu.Printer.Meat.Declaration.Warning+        Ormolu.Printer.Meat.ImportExport+        Ormolu.Printer.Meat.Module+        Ormolu.Printer.Meat.Pragma+        Ormolu.Printer.Meat.Type+        Ormolu.Printer.Operators+        Ormolu.Printer.SpanStream+        Ormolu.Processing.Common+        Ormolu.Processing.Cpp+        Ormolu.Processing.Postprocess+        Ormolu.Processing.Preprocess+        Ormolu.Utils -test-suite tests-  main-is:            Spec.hs-  hs-source-dirs:     tests-  type:               exitcode-stdio-1.0-  build-depends:      base           >= 4.12 && < 5.0-                    , containers     >= 0.5 && < 0.7-                    , filepath       >= 1.2 && < 1.5-                    , hspec          >= 2.0 && < 3.0-                    , ormolu-                    , path           >= 0.6 && < 0.8-                    , path-io        >= 1.4.2 && < 2.0-                    , text           >= 0.2 && < 1.3-  build-tools:        hspec-discover >= 2.0 && < 3.0-  other-modules:-                      Ormolu.Parser.PragmaSpec-                    , Ormolu.PrinterSpec+    hs-source-dirs:   src+    other-modules:+        GHC+        GHC.DynFlags -  if flag(dev)-    ghc-options:      -Wall -Werror-  else-    ghc-options:      -O2 -Wall-  default-language:   Haskell2010+    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        bytestring >=0.2 && <0.11,+        containers >=0.5 && <0.7,+        dlist >=0.8 && <0.9,+        exceptions >=0.6 && <0.11,+        ghc-lib-parser >=8.10 && <8.11,+        mtl >=2.0 && <3.0,+        syb >=0.7 && <0.8,+        text >=0.2 && <1.3 +    if flag(dev)+        ghc-options:+            -Wall -Werror -Wcompat -Wincomplete-record-updates+            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+            -Wno-missing-home-modules++    else+        ghc-options: -O2 -Wall+ executable ormolu-  main-is:            Main.hs-  hs-source-dirs:     app-  build-depends:      base           >= 4.12 && < 5.0-                    , ghc-lib-parser >= 8.10 && < 8.11-                    , gitrev         >= 1.3 && < 1.4-                    , optparse-applicative >= 0.14 && < 0.16-                    , ormolu-                    , text           >= 0.2 && < 1.3-  other-modules:      Paths_ormolu-  if flag(dev)-    ghc-options:      -Wall -Werror -Wcompat-                      -Wincomplete-record-updates-                      -Wincomplete-uni-patterns-                      -Wnoncanonical-monad-instances-  else-    ghc-options:      -O2 -Wall -rtsopts-  default-language:   Haskell2010+    main-is:          Main.hs+    hs-source-dirs:   app+    other-modules:    Paths_ormolu+    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        ghc-lib-parser >=8.10 && <8.11,+        gitrev >=1.3 && <1.4,+        optparse-applicative >=0.14 && <0.16,+        ormolu -any,+        text >=0.2 && <1.3++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wcompat -Wincomplete-record-updates+            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances++    else+        ghc-options: -O2 -Wall -rtsopts++test-suite tests+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    build-tools:      hspec-discover >=2.0 && <3.0+    hs-source-dirs:   tests+    other-modules:+        Ormolu.Parser.PragmaSpec+        Ormolu.PrinterSpec++    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        containers >=0.5 && <0.7,+        filepath >=1.2 && <1.5,+        hspec >=2.0 && <3.0,+        ormolu -any,+        path >=0.6 && <0.8,+        path-io >=1.4.2 && <2.0,+        text >=0.2 && <1.3++    if flag(dev)+        ghc-options: -Wall -Werror++    else+        ghc-options: -O2 -Wall

@@ -1,6 +1,5 @@ module GHC   ( module X,-    ParsedSource,   ) where @@ -11,5 +10,3 @@ import Module as X import RdrName as X import SrcLoc as X--type ParsedSource = Located (HsModule GhcPs)

@@ -63,7 +63,7 @@   -- 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+  when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do     let pathRendered = path ++ "<rendered>"     -- Parse the result of pretty-printing again and make sure that AST     -- is the same as AST of original snippet module span positions.@@ -79,7 +79,7 @@         Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)     -- Try re-formatting the formatted result to check if we get exactly     -- the same output.-    when (cfgCheckIdempotency cfg) $+    when (cfgCheckIdempotence cfg) $       let txt2 = printModule result1        in case diffText txt txt2 pathRendered of             Nothing -> return ()

@@ -24,7 +24,7 @@     -- | Output information useful for debugging     cfgDebug :: !Bool,     -- | Checks if re-formatting the result is idempotent-    cfgCheckIdempotency :: !Bool,+    cfgCheckIdempotence :: !Bool,     -- | Region selection     cfgRegion :: !region   }@@ -56,7 +56,7 @@     { cfgDynOptions = [],       cfgUnsafe = False,       cfgDebug = False,-      cfgCheckIdempotency = False,+      cfgCheckIdempotence = False,       cfgRegion =         RegionIndices           { regionStartLine = Nothing,

@@ -15,6 +15,7 @@ import qualified FastString as GHC import GHC import Ormolu.Imports (sortImports)+import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Utils @@ -38,14 +39,16 @@ diffParseResult   ParseResult     { prCommentStream = cstream0,-      prParsedSource = ps0+      prParsedSource = hs0     }   ParseResult     { prCommentStream = cstream1,-      prParsedSource = ps1+      prParsedSource = hs1     } =     matchIgnoringSrcSpans cstream0 cstream1-      <> matchIgnoringSrcSpans ps0 ps1+      <> matchIgnoringSrcSpans+        hs0 {hsmodImports = sortImports (hsmodImports hs0)}+        hs1 {hsmodImports = sortImports (hsmodImports hs1)}  -- | Compare two values for equality disregarding differences in 'SrcSpan's -- and the ordering of import lists.@@ -67,7 +70,7 @@           gzipWithQ             ( genericQuery                 `extQ` srcSpanEq-                `extQ` hsModuleEq+                `extQ` commentEq                 `extQ` sourceTextEq                 `extQ` hsDocStringEq                 `extQ` importDeclQualifiedStyleEq@@ -78,14 +81,14 @@       | otherwise = Different []     srcSpanEq :: SrcSpan -> GenericQ Diff     srcSpanEq _ _ = Same-    hsModuleEq :: HsModule GhcPs -> GenericQ Diff-    hsModuleEq hs0 hs1' =-      case cast hs1' :: Maybe (HsModule GhcPs) of+    commentEq :: Comment -> GenericQ Diff+    commentEq (Comment _ x) d =+      case cast d :: Maybe Comment of         Nothing -> Different []-        Just hs1 ->-          matchIgnoringSrcSpans-            hs0 {hsmodImports = sortImports (hsmodImports hs0)}-            hs1 {hsmodImports = sortImports (hsmodImports hs1)}+        Just (Comment _ y) ->+          if x == y+            then Same+            else Different []     sourceTextEq :: SourceText -> GenericQ Diff     sourceTextEq _ _ = Same     importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff

@@ -88,7 +88,7 @@           case pStateErrors pstate of             Just err -> Left err             Nothing -> error "PFailed does not have an error"-        GHC.POk pstate pmod ->+        GHC.POk pstate (L _ hsModule) ->           case pStateErrors pstate of             -- Some parse errors (pattern/arrow syntax in expr context)             -- do not cause a parse error, but they are replaced with "_"@@ -97,10 +97,10 @@             Just err -> Left err             Nothing ->               let (stackHeader, shebangs, pragmas, comments) =-                    mkCommentStream extraComments pstate+                    mkCommentStream input extraComments pstate                in Right                     ParseResult-                      { prParsedSource = pmod,+                      { prParsedSource = hsModule,                         prAnns = mkAnns pstate,                         prStackHeader = stackHeader,                         prShebangs = shebangs,

@@ -4,12 +4,16 @@  -- | Functions for working with comment stream. module Ormolu.Parser.CommentStream-  ( CommentStream (..),-    Comment (..),+  ( -- * Comment stream+    CommentStream (..),     mkCommentStream,-    isPrevHaddock,-    isMultilineComment,     showCommentStream,++    -- * Comment+    Comment (..),+    unComment,+    hasAtomsBefore,+    isMultilineComment,   ) where @@ -26,20 +30,20 @@ import Ormolu.Utils (showOutputable) import SrcLoc +----------------------------------------------------------------------------+-- Comment stream+ -- | A stream of 'RealLocated' 'Comment's in ascending order with respect to -- beginning of corresponding spans. newtype CommentStream = CommentStream [RealLocated Comment]   deriving (Eq, Data, Semigroup, Monoid) --- | A wrapper for a single comment. The 'NonEmpty' list inside contains--- lines of multiline comment @{- … -}@ or just single item\/line otherwise.-newtype Comment = Comment (NonEmpty String)-  deriving (Eq, Show, Data)- -- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are -- removed from the 'CommentStream'. Shebangs are only extracted from the -- comments that come from the first argument. mkCommentStream ::+  -- | Original input+  String ->   -- | Extra comments to include   [Located String] ->   -- | Parser state to use for comment extraction@@ -50,14 +54,14 @@     [([RealLocated Comment], Pragma)],     CommentStream   )-mkCommentStream extraComments pstate =+mkCommentStream input extraComments pstate =   ( mstackHeader,     shebangs,     pragmas,     CommentStream comments   )   where-    (comments, pragmas) = extractPragmas rawComments1+    (comments, pragmas) = extractPragmas input rawComments1     (rawComments1, mstackHeader) = extractStackHeader rawComments0     rawComments0 =       L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $@@ -68,15 +72,6 @@             (GHC.annotations_comments pstate)     (shebangs, otherExtraComments) = extractShebangs extraComments --- | Test whether a 'Comment' looks like a Haddock following a definition,--- i.e. something starting with @-- ^@.-isPrevHaddock :: Comment -> Bool-isPrevHaddock (Comment (x :| _)) = "-- ^" `L.isPrefixOf` x---- | Is this comment multiline-style?-isMultilineComment :: Comment -> Bool-isMultilineComment (Comment (x :| _)) = "{-" `L.isPrefixOf` x- -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String showCommentStream (CommentStream xs) =@@ -86,49 +81,68 @@     showComment (GHC.L l str) = showOutputable l ++ " " ++ show str  ------------------------------------------------------------------------------- Helpers+-- Comment +-- | A wrapper for a single comment. The 'Bool' indicates whether there were+-- atoms before beginning of the comment in the original input. The+-- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or+-- just single item\/line otherwise.+data Comment = Comment Bool (NonEmpty String)+  deriving (Eq, Show, Data)+ -- | Normalize comment string. Sometimes one multi-line comment is turned -- into several lines for subsequent outputting with correct indentation for -- each line.-mkComment :: RealLocated String -> RealLocated Comment-mkComment (L l s) =-  L l . Comment . fmap dropTrailing $-    if "{-" `L.isPrefixOf` s-      then case NE.nonEmpty (lines s) of-        Nothing -> s :| []-        Just (x :| xs) ->-          let getIndent y =-                if all isSpace y-                  then startIndent-                  else length (takeWhile isSpace y)-              n = minimum (startIndent : fmap getIndent xs)-           in x :| (drop n <$> xs)-      else s :| []+mkComment ::+  -- | Lines of original input with their indices+  [(Int, String)] ->+  -- | Raw comment string+  RealLocated String ->+  -- | Remaining lines of original input and the constructed 'Comment'+  ([(Int, String)], RealLocated Comment)+mkComment ls (L l s) = (ls', comment)   where+    comment =+      L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $+        if "{-" `L.isPrefixOf` s+          then case NE.nonEmpty (lines s) of+            Nothing -> s :| []+            Just (x :| xs) ->+              let getIndent y =+                    if all isSpace y+                      then startIndent+                      else length (takeWhile isSpace y)+                  n = minimum (startIndent : fmap getIndent xs)+               in x :| (drop n <$> xs)+          else s :| []+    (atomsBefore, ls') =+      case dropWhile ((< commentLine) . fst) ls of+        [] -> (False, [])+        ((_, i) : ls'') ->+          case take 2 (dropWhile isSpace i) of+            "--" -> (False, ls'')+            "{-" -> (False, ls'')+            _ -> (True, ls'')     dropTrailing = L.dropWhileEnd isSpace     startIndent = srcSpanStartCol l - 1+    commentLine = srcSpanStartLine l --- | Get a 'String' from 'GHC.AnnotationComment'.-unAnnotationComment :: GHC.AnnotationComment -> Maybe String-unAnnotationComment = \case-  GHC.AnnDocCommentNext _ -> Nothing -- @-- |@-  GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@-  GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@-  GHC.AnnDocSection _ _ -> Nothing -- @-- *@-  GHC.AnnDocOptions s -> Just s-  GHC.AnnLineComment s -> Just s-  GHC.AnnBlockComment s -> Just s+-- | Get a collection of lines from a 'Comment'.+unComment :: Comment -> NonEmpty String+unComment (Comment _ xs) = xs -liftMaybe :: Located (Maybe a) -> Maybe (Located a)-liftMaybe = \case-  L _ Nothing -> Nothing-  L l (Just a) -> Just (L l a)+-- | Check whether the 'Comment' had some non-whitespace atoms in front of+-- it in the original input.+hasAtomsBefore :: Comment -> Bool+hasAtomsBefore (Comment atomsBefore _) = atomsBefore -toRealSpan :: Located a -> Maybe (RealLocated a)-toRealSpan (L (RealSrcSpan l) a) = Just (L l a)-toRealSpan _ = Nothing+-- | Is this comment multiline-style?+isMultilineComment :: Comment -> Bool+isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x +----------------------------------------------------------------------------+-- Helpers+ -- | Detect and extract stack header if it is present. extractStackHeader ::   [RealLocated String] ->@@ -136,25 +150,60 @@ extractStackHeader = \case   [] -> ([], Nothing)   (x : xs) ->-    let comment = mkComment x+    let comment = snd (mkComment [] x)      in if isStackHeader (unRealSrcSpan comment)           then (xs, Just comment)           else (x : xs, Nothing)   where-    isStackHeader (Comment (x :| _)) =+    isStackHeader (Comment _ (x :| _)) =       "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x)  -- | Extract pragmas and their associated comments. extractPragmas ::+  String ->   [RealLocated String] ->   ([RealLocated Comment], [([RealLocated Comment], Pragma)])-extractPragmas = go id id+extractPragmas input = go initialLs id id   where-    go csSoFar pragmasSoFar = \case+    initialLs = zip [1 ..] (lines input)+    go ls csSoFar pragmasSoFar = \case       [] -> (csSoFar [], pragmasSoFar [])       (x : xs) ->         case parsePragma (unRealSrcSpan x) of-          Nothing -> go (csSoFar . (mkComment x :)) pragmasSoFar xs+          Nothing ->+            let (ls', x') = mkComment ls x+             in go ls' (csSoFar . (x' :)) pragmasSoFar xs           Just pragma ->             let combined = (csSoFar [], pragma)-             in go id (pragmasSoFar . (combined :)) xs+             in go ls id (pragmasSoFar . (combined :)) xs++-- | Get a 'String' from 'GHC.AnnotationComment'.+unAnnotationComment :: GHC.AnnotationComment -> Maybe String+unAnnotationComment = \case+  GHC.AnnDocCommentNext _ -> Nothing -- @-- |@+  GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@+  GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@+  GHC.AnnDocSection _ _ -> Nothing -- @-- *@+  GHC.AnnDocOptions s -> Just s+  GHC.AnnLineComment s -> Just s+  GHC.AnnBlockComment s -> Just s++liftMaybe :: Located (Maybe a) -> Maybe (Located a)+liftMaybe = \case+  L _ Nothing -> Nothing+  L l (Just a) -> Just (L l a)++toRealSpan :: Located a -> Maybe (RealLocated a)+toRealSpan (L (RealSrcSpan l) a) = Just (L l a)+toRealSpan _ = Nothing++-- | Remove consecutive blank lines.+removeConseqBlanks :: NonEmpty String -> NonEmpty String+removeConseqBlanks (x :| xs) = x :| go (null x) id xs+  where+    go seenBlank acc = \case+      [] -> acc []+      (y : ys) ->+        if seenBlank && null y+          then go True acc ys+          else go (null y) (acc . (y :)) ys

@@ -17,7 +17,7 @@ -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult   { -- | 'ParsedSource' from GHC-    prParsedSource :: ParsedSource,+    prParsedSource :: HsModule GhcPs,     -- | Ormolu-specfic representation of annotations     prAnns :: Anns,     -- | Stack header

@@ -51,6 +51,7 @@      -- ** Literals     comma,+    equals,      -- ** Stateful markers     SpanMark (..),@@ -62,12 +63,10 @@ where  import Control.Monad-import Data.Data (Data) import Data.List (intersperse) import Data.Text (Text) import Ormolu.Printer.Comments import Ormolu.Printer.Internal-import Ormolu.Utils (isModule) import SrcLoc  ----------------------------------------------------------------------------@@ -79,31 +78,20 @@ -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation. located ::-  Data a =>   -- | Thing to enter   Located a ->   -- | How to render inner value   (a -> R ()) ->   R ()-located loc f = do-  let withRealLocated (L l a) g =-        case l of-          UnhelpfulSpan _ -> return ()-          RealSrcSpan l' -> g (L l' a)-  withRealLocated loc spitPrecedingComments-  let setEnclosingSpan =-        case getLoc loc of-          UnhelpfulSpan _ -> id-          RealSrcSpan orf ->-            if isModule (unLoc loc)-              then id-              else withEnclosingSpan orf-  setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))-  withRealLocated loc spitFollowingComments+located (L (UnhelpfulSpan _) a) f = f a+located (L (RealSrcSpan l) a) f = do+  spitPrecedingComments l+  withEnclosingSpan l $+    switchLayout [RealSrcSpan l] (f a)+  spitFollowingComments l  -- | A version of 'located' with arguments flipped. located' ::-  Data a =>   -- | How to render inner value   (a -> R ()) ->   -- | Thing to enter@@ -288,3 +276,7 @@ -- | Print @,@. comma :: R () comma = txt ","++-- | Print @=@. Do not use @'txt' "="@.+equals :: R ()+equals = interferingTxt "="

@@ -13,13 +13,11 @@ where  import Control.Monad-import Data.Coerce (coerce)-import Data.Data (Data) import qualified Data.List.NonEmpty as NE+import Data.Maybe (listToMaybe) import qualified Data.Text as T import Ormolu.Parser.CommentStream import Ormolu.Printer.Internal-import Ormolu.Utils (isModule) import SrcLoc  ----------------------------------------------------------------------------@@ -27,9 +25,8 @@  -- | Output all preceding comments for an element at given location. spitPrecedingComments ::-  Data a =>-  -- | AST element to attach comments to-  RealLocated a ->+  -- | Span of the element to attach comments to+  RealSrcSpan ->   R () spitPrecedingComments ref = do   gotSome <- handleCommentSeries (spitPrecedingComment ref)@@ -37,16 +34,15 @@     lastMark <- getSpanMark     -- Insert a blank line between the preceding comments and the thing     -- after them if there was a blank line in the input.-    when (needsNewlineBefore (getRealSrcSpan ref) lastMark) newline+    when (needsNewlineBefore ref lastMark) newline  -- | Output all comments following an element at given location. spitFollowingComments ::-  Data a =>-  -- | AST element of attach comments to-  RealLocated a ->+  -- | Span of the element to attach comments to+  RealSrcSpan ->   R () spitFollowingComments ref = do-  trimSpanStream (getRealSrcSpan ref)+  trimSpanStream ref   void $ handleCommentSeries (spitFollowingComment ref)  -- | Output all remaining comments in the comment stream.@@ -62,49 +58,41 @@  -- | Output a single preceding comment for an element at given location. spitPrecedingComment ::-  Data a =>-  -- | AST element to attach comments to-  RealLocated a ->-  -- | Location of last comment in the series-  Maybe SpanMark ->+  -- | Span of the element to attach comments to+  RealSrcSpan ->   -- | Are we done?   R Bool-spitPrecedingComment (L ref a) mlastMark = do+spitPrecedingComment ref = do+  mlastMark <- getSpanMark   let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref   withPoppedComment p $ \l comment -> do-    dirtyLine <--      case mlastMark of-        -- 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-        -- an extra 'newline' in this case.-        Nothing -> isLineDirty -- only for very first preceding comment-        Just _ -> return False-    when (dirtyLine || needsNewlineBefore l mlastMark) newline+    lineSpans <- thisLineSpans+    let thisCommentLine = srcLocLine (realSrcSpanStart l)+        needsNewline =+          case listToMaybe lineSpans of+            Nothing -> False+            Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine+    when (needsNewline || needsNewlineBefore l mlastMark) newline     spitCommentNow l comment-    if theSameLinePre l ref && not (isModule a)+    if theSameLinePre l ref       then space       else newline  -- | Output a comment that follows element at given location immediately on -- the same line, if there is any. spitFollowingComment ::-  Data a =>   -- | AST element to attach comments to-  RealLocated a ->-  -- | Location of last comment in the series-  Maybe SpanMark ->+  RealSrcSpan ->   -- | Are we done?   R Bool-spitFollowingComment (L ref a) mlastMark = do+spitFollowingComment ref = do+  mlastMark <- getSpanMark   mnSpn <- nextEltSpan   -- Get first enclosing span that is not equal to reference span, i.e. it's   -- truly something enclosing the AST element.   meSpn <- getEnclosingSpan (/= ref)   withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->-    if theSameLinePost l ref && not (isModule a)+    if theSameLinePost l ref       then         if isMultilineComment comment           then space >> spitCommentNow l comment@@ -116,11 +104,10 @@  -- | Output a single remaining comment from the comment stream. spitRemainingComment ::-  -- | Location of last comment in the series-  Maybe SpanMark ->   -- | Are we done?   R Bool-spitRemainingComment mlastMark =+spitRemainingComment = do+  mlastMark <- getSpanMark   withPoppedComment (const True) $ \l comment -> do     when (needsNewlineBefore l mlastMark) newline     spitCommentNow l comment@@ -133,13 +120,13 @@ handleCommentSeries ::   -- | Given location of previous comment, output the next comment   -- returning 'True' if we're done-  (Maybe SpanMark -> R Bool) ->+  R Bool ->   -- | Whether we printed any comments   R Bool handleCommentSeries f = go False   where     go gotSome = do-      done <- getSpanMark >>= f+      done <- f       if done         then return gotSome         else go True@@ -219,9 +206,8 @@     -- 2) The comment logically belongs to the element, four cases:     logicallyFollows =       theSameLinePost l ref -- a) it's on the same line-        || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^-        || continuation -- c) it's a continuation of a comment block-        || lastInEnclosing -- d) it's the last element in the enclosing construct+        || continuation -- b) it's a continuation of a comment block+        || lastInEnclosing -- c) it's the last element in the enclosing construct      -- 3) There is no other AST element between this element and the comment:     noEltBetween =@@ -248,12 +234,16 @@                        >= abs (startColumn ref - startColumn l)                    )     continuation =-      case mlastMark of-        Just (HaddockSpan _ spn) ->-          srcSpanEndLine spn + 1 == srcSpanStartLine l-        Just (CommentSpan spn) ->-          srcSpanEndLine spn + 1 == srcSpanStartLine l-        _ -> False+      -- A comment is a continuation when it doesn't have non-whitespace+      -- lexemes in front of it and goes right after the previous comment.+      not (hasAtomsBefore comment)+        && ( case mlastMark of+               Just (HaddockSpan _ spn) ->+                 srcSpanEndLine spn + 1 == srcSpanStartLine l+               Just (CommentSpan spn) ->+                 srcSpanEndLine spn + 1 == srcSpanStartLine l+               _ -> False+           )     lastInEnclosing =       case meSpn of         -- When there is no enclosing element, return false@@ -275,7 +265,7 @@     . sequence_     . NE.intersperse newline     . fmap (txt . T.pack)-    . coerce+    . unComment     $ comment   setSpanMark (CommentSpan spn) @@ -291,6 +281,6 @@     . sequence_     . NE.toList     . fmap (registerPendingCommentLine position . T.pack)-    . coerce+    . unComment     $ comment   setSpanMark (CommentSpan spn)

@@ -14,10 +14,10 @@      -- * Internal functions     txt,+    interferingTxt,     atom,     space,     newline,-    isLineDirty,     useRecordDot,     inci,     sitcc,@@ -39,6 +39,7 @@     popComment,     getEnclosingSpan,     withEnclosingSpan,+    thisLineSpans,      -- * Stateful markers     SpanMark (..),@@ -98,18 +99,19 @@ data SC = SC   { -- | Index of the next column to render     scColumn :: !Int,+    -- | Indentation level that was used for the current line+    scIndent :: !Int,     -- | Rendered source code so far     scBuilder :: Builder,     -- | Span stream     scSpanStream :: SpanStream,+    -- | Spans of atoms that have been printed on the current line so far+    scThisLineSpans :: [RealSrcSpan],     -- | Comment stream     scCommentStream :: CommentStream,     -- | Pending comment lines (in reverse order) to be inserted before next     -- newline, 'Int' is the indentation level-    scPendingComments :: ![(CommentPosition, Int, Text)],-    -- | Whether the current line is “dirty”, that is, already contains-    -- atoms that can have comments attached to them-    scDirtyLine :: !Bool,+    scPendingComments :: ![(CommentPosition, Text)],     -- | Whether to output a space before the next output     scRequestedDelimiter :: !RequestedDelimiter,     -- | An auxiliary marker for keeping track of last output element@@ -175,11 +177,12 @@     sc =       SC         { scColumn = 0,+          scIndent = 0,           scBuilder = mempty,           scSpanStream = sstream,+          scThisLineSpans = [],           scCommentStream = cstream,           scPendingComments = [],-          scDirtyLine = False,           scRequestedDelimiter = VeryBeginning,           scSpanMark = Nothing         }@@ -187,6 +190,23 @@ ---------------------------------------------------------------------------- -- Internal functions +-- | Type of the thing to output. Influences the primary low-level rendering+-- function 'spit'.+data SpitType+  = -- | Simple opaque text that breaks comment series.+    SimpleText+  | -- | Like 'SimpleText', but assume that when this text is inserted it+    -- will separate an 'Atom' and its pending comments, so insert an extra+    -- 'newline' in that case to force the pending comments and continue on+    -- a fresh line.+    InterferingText+  | -- | An atom that typically have span information in the AST and can+    -- have comments attached to it.+    Atom+  | -- | Used for rendering comment lines.+    CommentPart+  deriving (Show, Eq)+ -- | Output a fixed 'Text' fragment. The argument may not contain any line -- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like -- keywords and pipes @|@ in functional dependencies.@@ -198,8 +218,15 @@   -- | 'Text' to output   Text ->   R ()-txt = spit False False+txt = spit SimpleText +-- |+interferingTxt ::+  -- | 'Text' to output+  Text ->+  R ()+interferingTxt = spit InterferingText+ -- | Output 'Outputable' fragment of AST. This can be used to output numeric -- literals and similar. Everything that doesn't have inner structure but -- does have an 'Outputable' instance.@@ -207,47 +234,59 @@   Outputable a =>   a ->   R ()-atom = spit True False . T.pack . showOutputable+atom = spit Atom . T.pack . showOutputable  -- | Low-level non-public helper to define 'txt' and 'atom'. spit ::-  -- | Should we mark the line as dirty?-  Bool ->-  -- | Used during outputting of pending comments?-  Bool ->+  -- | Type of the thing to spit+  SpitType ->   -- | 'Text' to output   Text ->   R ()-spit dirty printingComments txt' = do+spit stype text = do   requestedDel <- R (gets scRequestedDelimiter)+  pendingComments <- R (gets scPendingComments)+  when (stype == InterferingText && not (null pendingComments)) newline   case requestedDel of     RequestedNewline -> do       R . modify $ \sc ->         sc           { scRequestedDelimiter = RequestedNothing           }-      if printingComments-        then newlineRaw-        else newline+      case stype of+        CommentPart -> newlineRaw+        _ -> newline     _ -> return ()   R $ do     i <- asks rcIndent     c <- gets scColumn-    let spaces =-          if c < i-            then T.replicate (i - c) " "-            else bool mempty " " (requestedDel == RequestedSpace)-        indentedTxt = spaces <> txt'+    closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans+    let indentedTxt = spaces <> text+        spaces = T.replicate spacesN " "+        spacesN =+          if c == 0+            then i+            else bool 0 1 (requestedDel == RequestedSpace)     modify $ \sc ->       sc         { scBuilder = scBuilder sc <> fromText indentedTxt,           scColumn = scColumn sc + T.length indentedTxt,-          scDirtyLine = scDirtyLine sc || dirty,+          scIndent =+            if c == 0+              then i+              else scIndent sc,+          scThisLineSpans =+            let xs = scThisLineSpans sc+             in case stype of+                  Atom -> case closestEnclosing of+                    Nothing -> xs+                    Just x -> x : xs+                  _ -> xs,           scRequestedDelimiter = RequestedNothing,           scSpanMark =             -- If there are pending comments, do not reset last comment             -- location.-            if printingComments || (not . null . scPendingComments) sc+            if (stype == CommentPart) || (not . null . scPendingComments) sc               then scSpanMark sc               else Nothing         }@@ -279,21 +318,22 @@ -- hard to output more than one blank newline in a row. newline :: R () newline = do+  indent <- R (gets scIndent)   cs <- reverse <$> R (gets scPendingComments)   case cs of     [] -> newlineRaw-    ((position, _, _) : _) -> do+    ((position, _) : _) -> do       case position of         OnTheSameLine -> space         OnNextLine -> newlineRaw-      R . forM_ cs $ \(_, indent, txt') ->+      R . forM_ cs $ \(_, text) ->         let modRC rc =               rc                 { rcIndent = indent                 }             R m = do-              unless (T.null txt') $-                spit False True txt'+              unless (T.null text) $+                spit CommentPart text               newlineRaw          in local modRC m       R . modify $ \sc ->@@ -314,7 +354,8 @@             VeryBeginning -> builderSoFar             _ -> builderSoFar <> "\n",           scColumn = 0,-          scDirtyLine = False,+          scIndent = 0,+          scThisLineSpans = [],           scRequestedDelimiter = case scRequestedDelimiter sc of             AfterNewline -> RequestedNewline             RequestedNewline -> RequestedNewline@@ -322,14 +363,9 @@             _ -> AfterNewline         } --- | Check if the current line is “dirty”, that is, there is something on it--- 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+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@@ -346,8 +382,7 @@  -- | Set indentation level for the inner computation equal to current -- column. This makes sure that the entire inner block is uniformly--- \"shifted\" to the right. Only works (and makes sense) when enclosing--- layout is multi-line.+-- \"shifted\" to the right. sitcc :: R () -> R () sitcc (R m) = do   requestedDel <- R (gets scRequestedDelimiter)@@ -355,16 +390,9 @@   c <- R (gets scColumn)   let modRC rc =         rc-          { rcIndent = max i c + bool 0 1 (requestedDel == RequestedSpace)+          { rcIndent = max i (c + bool 0 1 (requestedDel == RequestedSpace))           }-  vlayout (R m) . R $ do-    modify $ \sc ->-      sc-        { scRequestedDelimiter = case requestedDel of-            RequestedSpace -> RequestedNothing-            other -> other-        }-    local modRC m+  R (local modRC m)  -- | Set 'Layout' for internal computation. enterLayout :: Layout -> R () -> R ()@@ -405,11 +433,10 @@   -- | 'Text' to output   Text ->   R ()-registerPendingCommentLine position txt' = R $ do-  i <- asks rcIndent+registerPendingCommentLine position text = R $ do   modify $ \sc ->     sc-      { scPendingComments = (position, i, txt') : scPendingComments sc+      { scPendingComments = (position, text) : scPendingComments sc       }  -- | Drop elements that begin before or at the same place as given@@ -468,6 +495,10 @@         { rcEnclosingSpans = spn : rcEnclosingSpans rc         } +-- | Get spans on this line so far.+thisLineSpans :: R [RealSrcSpan]+thisLineSpans = R (gets scThisLineSpans)+ ---------------------------------------------------------------------------- -- Stateful markers @@ -477,15 +508,15 @@     HaddockSpan HaddockStyle RealSrcSpan   | -- | Non-haddock comment     CommentSpan RealSrcSpan-  | -- | Non-comment span-    OtherSpan RealSrcSpan+  | -- | A statement in a do-block and such span+    StatementSpan RealSrcSpan  -- | Project 'RealSrcSpan' from 'SpanMark'. spanMarkSpan :: SpanMark -> RealSrcSpan spanMarkSpan = \case   HaddockSpan _ s -> s   CommentSpan s -> s-  OtherSpan s -> s+  StatementSpan s -> s  -- | Haddock string style. data HaddockStyle@@ -534,7 +565,7 @@  -- | Return 'True' if we can use braces in this context. canUseBraces :: R Bool-canUseBraces = R $ asks rcCanUseBraces+canUseBraces = R (asks rcCanUseBraces)  ---------------------------------------------------------------------------- -- Constants

@@ -154,10 +154,11 @@   LHsDocString ->   R () p_hsDocString hstyle needsNewline (L l str) = do-  goesAfterComment <- getSpanMark >>= \case-    Just (HaddockSpan _ _) -> return True-    Just (CommentSpan _) -> return True-    _ -> return False+  let isCommentSpan = \case+        HaddockSpan _ _ -> True+        CommentSpan _ -> True+        _ -> False+  goesAfterComment <- maybe False isCommentSpan <$> getSpanMark   -- Make sure the Haddock is separated by a newline from other comments.   when goesAfterComment newline   forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do

@@ -66,13 +66,17 @@           let singleConstRec = isSingleConstRec dd_cons           if singleConstRec             then space-            else breakpoint-          txt "="+            else+              if hasHaddocks dd_cons+                then newline+                else breakpoint+          equals           space+          layout <- getLayout           let s =-                vlayout-                  (space >> txt "|" >> space)-                  (newline >> txt "|" >> space)+                if layout == MultiLine || hasHaddocks dd_cons+                  then newline >> txt "|" >> space+                  else space >> txt "|" >> space               sitcc' =                 if singleConstRec                   then id@@ -150,7 +154,7 @@         PrefixCon xs -> do           p_rdrName con_name           unless (null xs) breakpoint-          inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs+          inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs         RecCon l -> do           p_rdrName con_name           breakpoint@@ -256,3 +260,9 @@     RecCon _ -> True     _ -> False isSingleConstRec _ = False++hasHaddocks :: [LConDecl GhcPs] -> Bool+hasHaddocks = any (f . unLoc)+  where+    f ConDeclH98 {..} = isJust con_doc+    f _ = False

@@ -43,7 +43,7 @@     inci $ do       located lhs p_hsExpr       space-      txt "="+      equals       inci $ do         breakpoint         located rhs p_hsExpr

@@ -48,11 +48,12 @@   p_rdrName n   if null ns     then p_typeAscription hswc-    else bool id inci indentTail $ do+    else do       comma       breakpoint-      sep (comma >> breakpoint) p_rdrName ns-      p_typeAscription hswc+      bool id inci indentTail $ do+        sep (comma >> breakpoint) p_rdrName ns+        p_typeAscription hswc  p_typeAscription ::   LHsSigWcType GhcPs ->@@ -74,7 +75,11 @@   R () p_patSynSig names hsib = do   txt "pattern"-  let body = p_typeSig False names HsWC {hswc_ext = NoExtField, hswc_body = hsib}+  let body =+        p_typeSig+          False+          names+          HsWC {hswc_ext = NoExtField, hswc_body = hsib}   if length names > 1     then breakpoint >> inci body     else space >> body

@@ -32,7 +32,9 @@       (p_rdrName name)       (map (located' p_hsTyVarBndr) hsq_explicit)   space-  txt "="-  breakpoint+  equals+  if hasDocStrings (unLoc t)+    then newline+    else breakpoint   inci (located t p_hsType) p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x

@@ -69,7 +69,7 @@         breakpoint         located k p_hsType       TyVarSig NoExtField bndr -> Just $ do-        txt "="+        equals         breakpoint         located bndr p_hsTyVarBndr       XFamilyResultSig x ->@@ -101,7 +101,7 @@         (p_rdrName feqn_tycon)         (located' p_hsType . typeArgToType <$> feqn_pats)     space-    txt "="+    equals     breakpoint     inci (located feqn_rhs p_hsType) p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x

@@ -217,35 +217,27 @@       -- about putting certain constructions in hanging positions.       endOfPats = case NE.nonEmpty m_pats of         Nothing -> case style of-          Function name -> (Just . srcSpanEnd . getLoc) name+          Function name -> Just (getLoc name)           _ -> Nothing-        Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats+        Just pats -> (Just . getLoc . NE.last) pats       isCase = \case         Case -> True         LambdaCase -> True         _ -> False   let hasGuards = withGuards grhssGRHSs-  unless (length grhssGRHSs > 1) $-    case style of-      Function _ | hasGuards -> return ()-      Function _ -> space >> txt "="-      PatternBind -> space >> txt "="-      s | isCase s && hasGuards -> return ()-      _ -> space >> txt "->"-  let grhssSpan =+      grhssSpan =         combineSrcSpans' $           getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs       patGrhssSpan =         maybe           grhssSpan-          (combineSrcSpans grhssSpan . srcLocSpan)+          (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)           endOfPats       placement =         case endOfPats of           Nothing -> blockPlacement placer grhssGRHSs           Just spn ->-            if isOneLineSpan-              (mkSrcSpan spn (srcSpanStart grhssSpan))+            if onTheSameLine spn grhssSpan               then blockPlacement placer grhssGRHSs               else Normal       p_body = do@@ -262,6 +254,13 @@           unless whereIsEmpty breakpoint           inci $ located grhssLocalBinds p_hsLocalBinds   inci' $ do+    unless (length grhssGRHSs > 1) $+      case style of+        Function _ | hasGuards -> return ()+        Function _ -> space >> inci equals+        PatternBind -> space >> inci equals+        s | isCase s && hasGuards -> return ()+        _ -> space >> txt "->"     switchLayout [patGrhssSpan] $       placeHanging placement p_body     inci p_where@@ -287,22 +286,22 @@       space       sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)       space-      txt $ case style of-        EqualSign -> "="-        RightArrow -> "->"+      inci $ case style of+        EqualSign -> equals+        RightArrow -> txt "->"       placeHanging placement p_body   where     placement =       case endOfGuards of         Nothing -> placer (unLoc body)         Just spn ->-          if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))+          if onTheSameLine spn (getLoc body)             then placer (unLoc body)             else Normal     endOfGuards =       case NE.nonEmpty guards of         Nothing -> Nothing-        Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs+        Just gs -> (Just . getLoc . NE.last) gs     p_body = located body render p_grhs' _ _ _ (XGRHS x) = noExtCon x @@ -363,7 +362,7 @@         -- Spacing before comments will be handled by the code         -- that prints comments, so we just have to deal with         -- blank lines between statements here.-        Just (OtherSpan lastSpn) ->+        Just (StatementSpan lastSpn) ->           if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1             then newline             else return ()@@ -374,7 +373,7 @@       getSpanMark >>= \case         Just (HaddockSpan _ _) -> return ()         Just (CommentSpan _) -> return ()-        _ -> setSpanMark (OtherSpan currentSpn)+        _ -> setSpanMark (StatementSpan currentSpn)  p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R () p_stmt = p_stmt' exprPlacement p_hsExpr@@ -495,7 +494,7 @@     let p_ipBind (IPBind NoExtField (Left name) expr) = do           atom name           space-          txt "="+          equals           breakpoint           useBraces $ inci $ located expr p_hsExpr         p_ipBind (IPBind NoExtField (Right _) _) =@@ -514,9 +513,12 @@   p_rdrName hsRecFieldLbl   unless hsRecPun $ do     space-    txt "="-    let placement = exprPlacement (unLoc hsRecFieldArg)-    placeHanging placement $ located hsRecFieldArg p_hsExpr+    equals+    let placement =+          if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)+            then exprPlacement (unLoc hsRecFieldArg)+            else Normal+    placeHanging placement (located hsRecFieldArg p_hsExpr)  p_hsTupArg :: HsTupArg GhcPs -> R () p_hsTupArg = \case@@ -661,7 +663,8 @@   HsIf NoExtField _ if' then' else' ->     p_if exprPlacement p_hsExpr if' then' else'   HsMultiIf NoExtField guards -> do-    txt "if "+    txt "if"+    breakpoint     inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards   HsLet NoExtField localBinds e ->     p_let p_hsExpr localBinds e@@ -819,7 +822,7 @@             breakpoint             located psb_def p_pat           ImplicitBidirectional -> do-            txt "="+            equals             breakpoint             located psb_def p_pat           ExplicitBidirectional mgroup -> do@@ -901,10 +904,12 @@   breakpoint   inci $ do     txt "then"+    space     located then' $ \x ->       placeHanging (placer x) (render x)     breakpoint     txt "else"+    space     located else' $ \x ->       placeHanging (placer x) (render x) @@ -1004,7 +1009,7 @@     p_rdrName (rdrNameFieldOcc x)   unless hsRecPun $ do     space-    txt "="+    equals     breakpoint     inci (located hsRecFieldArg p_pat) 

@@ -34,9 +34,9 @@   -- | Whether to use postfix qualified imports   Bool ->   -- | AST to print-  ParsedSource ->+  HsModule GhcPs ->   R ()-p_hsModule mstackHeader shebangs pragmas qualifiedPost (L _ HsModule {..}) = do+p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do   let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage       exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports   switchLayout (deprecSpan <> exportSpans) $ do

@@ -5,6 +5,7 @@ -- | Rendering of types. module Ormolu.Printer.Meat.Type   ( p_hsType,+    p_hsTypePostDoc,     hasDocStrings,     p_hsContext,     p_hsTyVarBndr,@@ -23,14 +24,22 @@ import Ormolu.Utils  p_hsType :: HsType GhcPs -> R ()-p_hsType t = p_hsType' (hasDocStrings t) t+p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t -p_hsType' :: Bool -> HsType GhcPs -> R ()-p_hsType' multilineArgs = \case+p_hsTypePostDoc :: HsType GhcPs -> R ()+p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t++-- | How to render Haddocks associated with a type.+data TypeDocStyle+  = PipeStyle+  | CaretStyle++p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()+p_hsType' multilineArgs docStyle = \case   HsForAllTy NoExtField visibility bndrs t -> do     p_forallBndrs visibility p_hsTyVarBndr bndrs     interArgBreak-    p_hsType' multilineArgs (unLoc t)+    p_hsTypeR (unLoc t)   HsQualTy NoExtField qs t -> do     located qs p_hsContext     space@@ -114,9 +123,15 @@     space     inci (located k p_hsType)   HsSpliceTy NoExtField splice -> p_hsSplice splice-  HsDocTy NoExtField t str -> do-    p_hsDocString Pipe True str-    located t p_hsType+  HsDocTy NoExtField t str ->+    case docStyle of+      PipeStyle -> do+        p_hsDocString Pipe True str+        located t p_hsType+      CaretStyle -> do+        located t p_hsType+        newline+        p_hsDocString Caret False str   HsBangTy NoExtField (HsSrcBang _ u s) t -> do     case u of       SrcUnpack -> txt "{-# UNPACK #-}" >> space@@ -156,14 +171,14 @@   where     isPromoted = \case       HsTyVar _ IsPromoted _ -> True-      HsExplicitListTy {} -> True       HsExplicitTupleTy {} -> True+      HsExplicitListTy {} -> True       _ -> False     interArgBreak =       if multilineArgs         then newline         else breakpoint-    p_hsTypeR = p_hsType' multilineArgs+    p_hsTypeR = p_hsType' multilineArgs docStyle  -- | Return 'True' if at least one argument in 'HsType' has a doc string -- attached to it.

@@ -12,8 +12,9 @@  import Data.Function (on) import qualified Data.List as L+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe)-import Data.Ord (Down (Down), comparing) import GHC import OccName (mkVarOcc) import Ormolu.Utils (unSrcSpan)@@ -56,7 +57,7 @@ reassociateOpTreeWith ::   forall ty op.   -- | Fixity map for operators-  [(RdrName, Fixity)] ->+  Map RdrName Fixity ->   -- | How to get the name of an operator   (op -> Maybe RdrName) ->   -- | Original 'OpTree'@@ -68,12 +69,12 @@     fixityOf :: op -> Fixity     fixityOf op = fromMaybe defaultFixity $ do       opName <- getOpName op-      lookup opName fixityMap+      M.lookup opName fixityMap     -- Here, left branch is already associated and the root alongside with     -- the right branch is right-associated. This function picks up one item     -- from the right and inserts it correctly to the left.     ---    -- Also, we are using the 'compareFixity' function which returns if the+    -- Also, we are using the 'compareFixity' function which tells if the     -- expression should associate to right.     go :: OpTree ty op -> OpTree ty op     -- base cases@@ -93,6 +94,16 @@         then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'         else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r' +-- | A score assigned to an operator.+data Score+  = -- | The operator was placed at the beginning of a line+    AtBeginning Int+  | -- | The operator was placed at the end of a line+    AtEnd+  | -- | The operator was placed in between arguments on a single line+    InBetween+  deriving (Eq, Ord)+ -- | Build a map of inferred 'Fixity's from an 'OpTree'. buildFixityMap ::   forall ty op.@@ -101,23 +112,26 @@   -- | Operator tree   OpTree (Located ty) (Located op) ->   -- | Fixity map-  [(RdrName, Fixity)]+  Map RdrName Fixity buildFixityMap getOpName opTree =-  concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)-    . zip [0 ..]-    . L.groupBy (doubleWithinEps 0.00001 `on` snd)-    . (overrides ++)-    . modeScores+  addOverrides+    . M.fromList+    . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)+    . zip [1 ..]+    . L.groupBy ((==) `on` snd)+    . selectScores     $ score opTree   where-    -- Add a special case for ($), since it is pretty unlikely for someone-    -- to override it.-    overrides :: [(RdrName, Double)]-    overrides =-      [ (mkRdrUnqual $ mkVarOcc "$", -1)-      ]-    -- Assign scores to operators based on their location in the source.-    score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]+    addOverrides :: Map RdrName Fixity -> Map RdrName Fixity+    addOverrides m =+      let mk k v = (mkRdrUnqual (mkVarOcc k), fixity v InfixL)+       in M.fromList+            [ mk "$" 0,+              mk "." 9+            ]+            `M.union` m+    fixity = Fixity NoSourceText+    score :: OpTree (Located ty) (Located op) -> [(RdrName, Score)]     score (OpNode _) = []     score (OpBranch l o r) = fromMaybe (score r) $ do       -- If we fail to get any of these, 'defaultFixity' will be used by@@ -129,46 +143,25 @@       oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column       opName <- getOpName (unLoc o)       let s-            | le < ob =-              -- if the operator is in the beginning of a line, assign-              -- a score relative to its column within range [0, 1).-              fromIntegral oc / fromIntegral (maxCol + 1)-            | oe < rb =-              -- if the operator is in the end of the line, assign the-              -- score 1.-              1-            | otherwise =-              2 -- otherwise, assign a high score.+            | le < ob = AtBeginning oc+            | oe < rb = AtEnd+            | otherwise = InBetween       return $ (opName, s) : score r-    -- Pick the most common score per 'RdrName'.-    modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]-    modeScores =+    selectScores :: [(RdrName, Score)] -> [(RdrName, Score)]+    selectScores =       L.sortOn snd         . mapMaybe           ( \case               [] -> Nothing-              xs@((n, _) : _) -> Just (n, mode $ map snd xs)+              xs@((n, _) : _) -> Just (n, selectScore $ map snd xs)           )         . L.groupBy ((==) `on` fst)         . L.sort-    -- Return the most common number, leaning to the smaller-    -- one in case of a tie.-    mode :: [Double] -> Double-    mode =-      head-        . L.minimumBy (comparing (Down . length))-        . L.groupBy (doubleWithinEps 0.0001)-        . L.sort-    -- The start column of the rightmost operator.-    maxCol = go opTree-      where-        go (OpNode (L _ _)) = 0-        go (OpBranch l (L o _) r) =-          maximum-            [ go l,-              maybe 0 srcSpanStartCol (unSrcSpan o),-              go r-            ]+    selectScore :: [Score] -> Score+    selectScore xs =+      case filter (/= InBetween) xs of+        [] -> InBetween+        xs' -> maximum xs'  ---------------------------------------------------------------------------- -- Helpers@@ -182,9 +175,3 @@   OpBranch (OpNode l) lop (normalizeOpTree r) normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =   normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))--fixity :: Int -> FixityDirection -> Fixity-fixity = Fixity NoSourceText--doubleWithinEps :: Double -> Double -> Double -> Bool-doubleWithinEps eps a b = abs (a - b) < eps

@@ -6,7 +6,6 @@   ( RelativePos (..),     attachRelativePos,     combineSrcSpans',-    isModule,     notImplemented,     showOutputable,     splitDocString,@@ -15,10 +14,10 @@     incSpanLine,     separatedByBlank,     separatedByBlankNE,+    onTheSameLine,   ) where -import Data.Data (Data, showConstr, toConstr) import Data.List (dropWhileEnd) import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty (..))@@ -52,10 +51,6 @@ combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs --- | Return 'True' if given element of AST is module.-isModule :: Data a => a -> Bool-isModule x = showConstr (toConstr x) == "HsModule"- -- | Placeholder for things that are not yet implemented. notImplemented :: String -> a notImplemented msg = error $ "not implemented yet: " ++ msg@@ -139,3 +134,8 @@ -- | Do two declaration groups have a blank between them? separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)++-- | Return 'True' if one span ends on the same line the second one starts.+onTheSameLine :: SrcSpan -> SrcSpan -> Bool+onTheSameLine a b =+  isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))

@@ -62,7 +62,7 @@ -- | A version of 'shouldBe' that is specialized to comparing 'Text' values. -- It also prints multi-line snippets in a more readable form. shouldMatch :: Bool -> Text -> Text -> Expectation-shouldMatch idempotencyTest actual expected =+shouldMatch idempotenceTest actual expected =   when (actual /= expected) . expectationFailure $     unlines       [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):",@@ -72,8 +72,8 @@       ]   where     pass =-      if idempotencyTest-        then "idempotency pass"+      if idempotenceTest+        then "idempotence pass"         else "first pass"  examplesDir :: Path Rel Dir