ormolu 0.1.0.0 → 0.1.1.0

raw patch · 72 files changed

+760/−396 lines, 72 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +40/−2
• README.md +3/−2
• data/examples/declaration/value/function/arg-breakpoints-out.hs +3/−0
• data/examples/declaration/value/function/arg-breakpoints.hs +3/−0
• data/examples/declaration/value/function/blank-lines-let-out.hs +6/−0
• data/examples/declaration/value/function/blank-lines-let.hs +9/−0
• data/examples/declaration/value/function/blank-lines-where-out.hs +6/−0
• data/examples/declaration/value/function/blank-lines-where.hs +7/−0
• data/examples/declaration/value/function/infix/dollar-chains-out.hs +3/−3
• data/examples/declaration/value/function/infix/hanging-out.hs +4/−3
• data/examples/declaration/value/function/infix/lenses-out.hs +8/−7
• data/examples/declaration/value/function/list-notation-0-out.hs +5/−0
• data/examples/declaration/value/function/list-notation-0.hs +5/−0
• data/examples/declaration/value/function/list-notation-1-out.hs +8/−0
• data/examples/declaration/value/function/list-notation-1.hs +7/−0
• data/examples/declaration/value/function/list-notation-2-out.hs +6/−0
• data/examples/declaration/value/function/list-notation-2.hs +5/−0
• data/examples/declaration/value/function/list-notation-3-out.hs +12/−0
• data/examples/declaration/value/function/list-notation-3.hs +10/−0
• data/examples/declaration/value/function/type-applications-and-splice-out.hs +4/−0
• data/examples/declaration/value/function/type-applications-and-splice.hs +4/−0
• data/examples/import/deduplication-bug-out.hs +6/−0
• data/examples/import/deduplication-bug.hs +6/−0
• data/examples/import/explicit-imports-out.hs +4/−4
• data/examples/import/explicit-imports-with-comments-out.hs +3/−2
• data/examples/import/merging-0-out.hs +3/−0
• data/examples/import/merging-0.hs +4/−0
• data/examples/import/merging-1-out.hs +2/−0
• data/examples/import/merging-1.hs +3/−0
• data/examples/import/merging-2-out.hs +2/−0
• data/examples/import/merging-2.hs +4/−0
• data/examples/import/misc-out.hs +0/−6
• data/examples/import/nested-explicit-imports-out.hs +6/−6
• data/examples/import/qualified-post-out.hs +1/−1
• data/examples/import/qualified-prelude-out.hs +1/−1
• data/examples/import/simple-out.hs +2/−3
• data/examples/import/simple.hs +2/−0
• data/examples/import/sorted-export-list-out.hs +1/−0
• data/examples/import/sorted-export-list.hs +1/−0
• data/examples/other/comment-trailing-space-out.hs +9/−0
• data/examples/other/comment-trailing-space.hs +9/−0
• data/examples/other/pragma-comments-after-out.hs +4/−0
• data/examples/other/pragma-comments-after.hs +3/−0
• ormolu.cabal +2/−1
• src/Ormolu/Diff.hs +3/−3
• src/Ormolu/Imports.hs +161/−44
• src/Ormolu/Parser.hs +5/−3
• src/Ormolu/Parser/CommentStream.hs +22/−5
• src/Ormolu/Parser/Result.hs +3/−1
• src/Ormolu/Printer.hs +1/−1
• src/Ormolu/Printer/Combinators.hs +23/−7
• src/Ormolu/Printer/Internal.hs +3/−1
• src/Ormolu/Printer/Meat/Common.hs +6/−6
• src/Ormolu/Printer/Meat/Declaration.hs +12/−10
• src/Ormolu/Printer/Meat/Declaration/Class.hs +2/−2
• src/Ormolu/Printer/Meat/Declaration/Data.hs +27/−34
• src/Ormolu/Printer/Meat/Declaration/Default.hs +2/−2
• src/Ormolu/Printer/Meat/Declaration/Instance.hs +5/−9
• src/Ormolu/Printer/Meat/Declaration/Rule.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/Signature.hs +25/−28
• src/Ormolu/Printer/Meat/Declaration/Type.hs +1/−1
• src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +3/−3
• src/Ormolu/Printer/Meat/Declaration/Value.hs +149/−142
• src/Ormolu/Printer/Meat/Declaration/Warning.hs +4/−5
• src/Ormolu/Printer/Meat/ImportExport.hs +4/−5
• src/Ormolu/Printer/Meat/Module.hs +2/−2
• src/Ormolu/Printer/Meat/Type.hs +11/−15
• src/Ormolu/Printer/Operators.hs +16/−16
• src/Ormolu/Processing/Common.hs +1/−1
• src/Ormolu/Processing/Postprocess.hs +13/−3
• src/Ormolu/Processing/Preprocess.hs +4/−4
• src/Ormolu/Utils.hs +15/−1

@@ -1,3 +1,41 @@+## Ormolu 0.1.1.0++* Imports in a import lists are now normalized: duplicate imports are+  combined/eliminated intelligently.++* Import declarations that can be merged are now automatically merged.+  [Issue 414](https://github.com/tweag/ormolu/issues/414).++* The magic comments for disabling and enabling Ormolu now can encompass any+  fragment of code provided that the remaining code after exclusion of the+  disabled part is still syntactically correct. [Issue+  601](https://github.com/tweag/ormolu/issues/601).++* Improved sorting of operators in imports. [Issue+  602](https://github.com/tweag/ormolu/issues/602).++* Fixed a bug related to trailing space in multiline comments in certain+  cases. [Issue 603](https://github.com/tweag/ormolu/issues/602).++* Added support for formatting linked lists with `(:)` as line terminator.+  [Issue 478](https://github.com/tweag/ormolu/issues/478).++* Fixed rendering of function arguments in multiline layout. [Issue+  609](https://github.com/tweag/ormolu/issues/609).++* Blank lines between definitions in `let` and `while` bindings are now+  preserved. [Issue 554](https://github.com/tweag/ormolu/issues/554).++* Fixed the bug when type applications stuck to the `$` of TH splices that+  followed them. [Issue 613](https://github.com/tweag/ormolu/issues/613).++* Improved region formatting so that indented fragments—such as definitions+  inside of `where` clauses—can be formatted. [Issue+  572](https://github.com/tweag/ormolu/issues/572).++* Fixed the bug related to the de-association of pragma comments. [Issue+  619](https://github.com/tweag/ormolu/issues/619).+ ## Ormolu 0.1.0.0  * Fixed rendering of type signatures concerning several identifiers. [Issue@@ -6,7 +44,7 @@ * 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+* Fixed an idempotence issue when certain comments were picked up as   “continuation” of a series of comments [Issue   449](https://github.com/tweag/ormolu/issues/449). @@ -25,7 +63,7 @@   multiple blank lines in a row. [Issue   518](https://github.com/tweag/ormolu/issues/518). -* Fixed rendering of comment around if expressions. [Issue+* Fixed rendering of comments around if expressions. [Issue   458](https://github.com/tweag/ormolu/issues/458).  * Unnamed fields of data constructors are now documented using the `-- ^`

@@ -45,11 +45,12 @@  ```console $ cat stack.yaml-resolver: lts-14.3+resolver: lts-16.0 packages: - '.' -$ stack build+$ stack build -- to build+$ stack install -- to install ```  To use Ormolu directly from GitHub with Nix, this snippet may come in handy:

@@ -0,0 +1,3 @@+foo+  bar =+    body

@@ -0,0 +1,3 @@+foo+  bar =+    body

@@ -0,0 +1,6 @@+foo =+  let x = 10++      y = 11+      z = 12+   in x + y + z

@@ -0,0 +1,9 @@+foo =+  let++    x = 10++    y = 11+    z = 12++  in x + y + z

@@ -0,0 +1,6 @@+foo = x + y + z+  where+    x = 10++    y = 11+    z = 12

@@ -0,0 +1,7 @@+foo = x + y + z+  where++    x = 10++    y = 11+    z = 12

@@ -13,9 +13,9 @@     throwIO (OrmoluCppEnabled path)  foo =-  bar-    $ baz-    $ quux+  bar $+    baz $+      quux  x =   case l of { A -> B } $

@@ -17,6 +17,7 @@     `catch` \case       a -> a -foo = bar-  ++ case foo of-    a -> a+foo =+  bar+    ++ case foo of+      a -> a

@@ -1,11 +1,12 @@ lenses =-  Just $ M.fromList $-    "type" .= ("user.connection" :: Text)-      # "connection" .= uc-      # "user" .= case name of-        Just n -> Just $ object ["name" .= n]-        Nothing -> Nothing-      # []+  Just $+    M.fromList $+      "type" .= ("user.connection" :: Text)+        # "connection" .= uc+        # "user" .= case name of+          Just n -> Just $ object ["name" .= n]+          Nothing -> Nothing+        # []  foo =   a

@@ -0,0 +1,5 @@+foo =+  testCase "Foo" testFoo :+  testCase "Bar" testBar :+  testCase "Baz" testBaz :+  []

@@ -0,0 +1,5 @@+foo =+  testCase "Foo" testFoo :+  testCase "Bar" testBar :+  testCase "Baz" testBaz :+  []

@@ -0,0 +1,8 @@+instance A.ToJSON UpdateTable where+  toJSON a =+    A.object $+      "TableName" .= updateTableName a :+      "ProvisionedThroughput" .= updateProvisionedThroughput a :+      case updateGlobalSecondaryIndexUpdates a of+        [] -> []+        l -> ["GlobalSecondaryIndexUpdates" .= l]

@@ -0,0 +1,7 @@+instance A.ToJSON UpdateTable where+    toJSON a = A.object+        $ "TableName" .= updateTableName a+        : "ProvisionedThroughput" .= updateProvisionedThroughput a+        : case updateGlobalSecondaryIndexUpdates a of+            [] -> []+            l -> [ "GlobalSecondaryIndexUpdates" .= l ]

@@ -0,0 +1,6 @@+-- A list of the element and all its parents up to the root node.+getPath tree t =+  t :+  case Map.lookup (getId t) tree of+    Nothing -> []+    Just parent -> getPath tree parent

@@ -0,0 +1,5 @@+-- A list of the element and all its parents up to the root node.+getPath tree t = t :+    case Map.lookup (getId t) tree of+        Nothing     -> []+        Just parent -> getPath tree parent

@@ -0,0 +1,12 @@+foo =+  reportSDoc "tc.cc" 30 $+    sep $ do+      (prettyTCM q <+> " before compilation") : do+        map (prettyTCM . map unArg . clPats) cls++foo =+  reportSDoc "tc.cc" 30 $+    sep $ do+      (prettyTCM q <+> " before compilation") :+        do+          map (prettyTCM . map unArg . clPats) cls

@@ -0,0 +1,10 @@+foo =+  reportSDoc "tc.cc" 30 $ sep $ do+    (prettyTCM q <+> " before compilation") : do+      map (prettyTCM . map unArg . clPats) cls++foo =+  reportSDoc "tc.cc" 30 $ sep $ do+    (prettyTCM q <+> " before compilation") :+      do+        map (prettyTCM . map unArg . clPats) cls

@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++staticKey name = [|sing @ $(symFQN name)|]

@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++staticKey name = [| sing @ $(symFQN name) |]

@@ -0,0 +1,6 @@+import Foo1 (Bar1 (..), Baz1)+import Foo2 (Bar2 (..), Baz2)+import Foo3 (Bar3 (x1, x2, x3))+import Foo4 (Bar4 (x1, x2))+import Foo5 (Bar5 (x1))+import Foo6 (Bar6 (..))

@@ -0,0 +1,6 @@+import Foo1 (Bar1, Baz1, Bar1(..))+import Foo2 (Bar2(..), Baz2, Bar2)+import Foo3 (Bar3(x1,x3), Bar3(x1, x2))+import Foo4 (Bar4(x1), Bar4(x2))+import Foo5 (Bar5, Bar5(x1))+import Foo6 (Bar6(x1), Bar6(..))

@@ -1,12 +1,12 @@ import qualified MegaModule as M-  ( (<<<),-    (>>>),-    Either,+  ( Either,     Maybe (Just, Nothing),     MaybeT (..),-    Monad ((>>), (>>=), return),+    Monad (return, (>>), (>>=)),     MonadBaseControl,     join,     liftIO,     void,+    (<<<),+    (>>>),   )

@@ -1,6 +1,7 @@ import qualified MegaModule as M   ( -- (1)-    (<<<), -- (2)-    (>>>),+    -- (2)     Either, -- (3)+    (<<<),+    (>>>),   )

@@ -0,0 +1,3 @@+import Foo+import Foo (bar, foo)+import Foo as F

@@ -0,0 +1,4 @@+import Foo+import Foo (foo)+import Foo (bar)+import Foo as F

@@ -0,0 +1,2 @@+import "bar" Foo (bar)+import "foo" Foo (baz, foo)

@@ -0,0 +1,3 @@+import "foo" Foo (foo)+import "bar" Foo (bar)+import "foo" Foo (baz)

@@ -0,0 +1,2 @@+import Foo hiding (bar4, foo2)+import qualified Foo (bar3, foo1)

@@ -0,0 +1,4 @@+import qualified Foo (foo1)+import Foo hiding (foo2)+import qualified Foo (bar3)+import Foo hiding (bar4)

@@ -1,11 +1,5 @@ import A hiding   ( foobarbazqux,-    foobarbazqux,-    foobarbazqux,-    foobarbazqux,-    foobarbazqux,-    foobarbazqux,-    foobarbazqux,   ) import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f) import Name hiding ()

@@ -1,10 +1,10 @@ import qualified MegaModule as M-  ( (<<<),-    (>>>),-    Either,+  ( Either,     Monad-      ( (>>),-        (>>=),-        return+      ( return,+        (>>),+        (>>=)       ),+    (<<<),+    (>>>),   )

@@ -1,5 +1,5 @@ {-# LANGUAGE ImportQualifiedPost #-} -import Data.Text qualified as T import Data.Text qualified (a, b, c) import Data.Text qualified hiding (a, b, c)+import Data.Text qualified as T

@@ -1,4 +1,4 @@ module P where +import Prelude hiding (id, (.)) import qualified Prelude-import Prelude hiding ((.), id)

@@ -1,6 +1,5 @@ import Data.Text-import Data.Text-import qualified Data.Text as T-import qualified Data.Text (a, b, c) import Data.Text (a, b, c) import Data.Text hiding (a, b, c)+import qualified Data.Text (a, b, c)+import qualified Data.Text as T

@@ -4,3 +4,5 @@ import qualified Data.Text (a, c, b) import Data.Text (a, b, c) import Data.Text hiding (c, b, a)+import Data.Text (a, b, c, b, a)+import Data.Text hiding (c, b, a, b, c)

@@ -0,0 +1,1 @@+import Linear.Vector (Additive (..), (*^), (^*))

@@ -0,0 +1,1 @@+import Linear.Vector (Additive (..), (*^), (^*))

@@ -0,0 +1,9 @@+data T+  = {-++      some multi-line comment++      with empty lines++    -}+    A

@@ -0,0 +1,9 @@+data T+  = {-++      some multi-line comment++      with empty lines++    -}+    A

@@ -0,0 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+-- TODO: Fix and delete this pragma+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- TODO: Fix and delete this pragma+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}

@@ -1,6 +1,6 @@ cabal-version:   1.18 name:            ormolu-version:         0.1.0.0+version:         0.1.1.0 license:         BSD3 license-file:    LICENSE.md maintainer:      Mark Karpov <mark.karpov@tweag.io>@@ -152,6 +152,7 @@         ghc-options:             -Wall -Werror -Wcompat -Wincomplete-record-updates             -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+            -optP-Wno-nonportable-include-path      else         ghc-options: -O2 -Wall -rtsopts

@@ -14,7 +14,7 @@ import qualified Data.Text as T import qualified FastString as GHC import GHC-import Ormolu.Imports (sortImports)+import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Utils@@ -47,8 +47,8 @@     } =     matchIgnoringSrcSpans cstream0 cstream1       <> matchIgnoringSrcSpans-        hs0 {hsmodImports = sortImports (hsmodImports hs0)}-        hs1 {hsmodImports = sortImports (hsmodImports hs1)}+        hs0 {hsmodImports = normalizeImports (hsmodImports hs0)}+        hs1 {hsmodImports = normalizeImports (hsmodImports hs1)}  -- | Compare two values for equality disregarding differences in 'SrcSpan's -- and the ordering of import lists.

@@ -4,82 +4,199 @@  -- | Manipulations on import lists. module Ormolu.Imports-  ( sortImports,+  ( normalizeImports,   ) where  import Data.Bifunctor+import Data.Char (isAlphaNum) import Data.Function (on)-import Data.Generics (gcompare)-import Data.List (sortBy)+import Data.List (foldl', nubBy, sortBy, sortOn)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import FastString (FastString) import GHC hiding (GhcPs, IE) import GHC.Hs.Extension import GHC.Hs.ImpExp (IE (..))-import Ormolu.Utils (notImplemented)+import Ormolu.Utils (notImplemented, showOutputable) --- | Sort imports by module name. This also sorts explicit import lists for--- each declaration.-sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]-sortImports = sortBy compareIdecl . fmap (fmap sortImportLists)+-- | Sort and normalize imports.+normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]+normalizeImports =+  fmap snd+    . M.toAscList+    . M.fromListWith combineImports+    . fmap (\x -> (importId x, g x))   where-    sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs-    sortImportLists = \case-      ImportDecl {..} ->+    g (L l ImportDecl {..}) =+      L+        l         ImportDecl-          { ideclHiding = second (fmap sortLies) <$> ideclHiding,+          { ideclHiding = second (fmap normalizeLies) <$> ideclHiding,             ..           }-      XImportDecl x -> noExtCon x+    g _ = notImplemented "XImportDecl" --- | Compare two @'LImportDecl' 'GhcPs'@ things.-compareIdecl :: LImportDecl GhcPs -> LImportDecl GhcPs -> Ordering-compareIdecl (L _ m0) (L _ m1) =-  case (isPrelude n0, isPrelude n1) of-    (False, False) -> n0 `compare` n1-    (True, False) -> GT-    (False, True) -> LT-    (True, True) -> m0 `gcompare` m1+-- | Combine two import declarations. It should be assumed that 'ImportId's+-- are equal.+combineImports ::+  LImportDecl GhcPs ->+  LImportDecl GhcPs ->+  LImportDecl GhcPs+combineImports (L lx ImportDecl {..}) (L _ y) =+  L+    lx+    ImportDecl+      { ideclHiding = case (ideclHiding, GHC.ideclHiding y) of+          (Just (hiding, L l' xs), Just (_, L _ ys)) ->+            Just (hiding, (L l' (normalizeLies (xs ++ ys))))+          _ -> Nothing,+        ..+      }+combineImports _ _ = notImplemented "XImportDecl"++-- | Import id, a collection of all things that justify having a separate+-- import entry. This is used for merging of imports. If two imports have+-- the same 'ImportId' they can be merged.+data ImportId = ImportId+  { importIsPrelude :: Bool,+    importIdName :: ModuleName,+    importPkgQual :: Maybe FastString,+    importSource :: Bool,+    importSafe :: Bool,+    importQualified :: Bool,+    importImplicit :: Bool,+    importAs :: Maybe ModuleName,+    importHiding :: Maybe Bool+  }+  deriving (Eq, Ord)++-- | Obtain an 'ImportId' for a given import.+importId :: LImportDecl GhcPs -> ImportId+importId (L _ ImportDecl {..}) =+  ImportId+    { importIsPrelude = isPrelude,+      importIdName = moduleName,+      importPkgQual = sl_fs <$> ideclPkgQual,+      importSource = ideclSource,+      importSafe = ideclSafe,+      importQualified = case ideclQualified of+        QualifiedPre -> True+        QualifiedPost -> True+        NotQualified -> False,+      importImplicit = ideclImplicit,+      importAs = unLoc <$> ideclAs,+      importHiding = fst <$> ideclHiding+    }   where-    n0 = unLoc (ideclName m0)-    n1 = unLoc (ideclName m1)-    isPrelude = (== "Prelude") . moduleNameString+    isPrelude = moduleNameString moduleName == "Prelude"+    moduleName = unLoc ideclName+importId _ = notImplemented "XImportDecl" --- | Sort located import or export.-sortLies :: [LIE GhcPs] -> [LIE GhcPs]-sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)+-- | Normalize a collection of import\/export items.+normalizeLies :: [LIE GhcPs] -> [LIE GhcPs]+normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty+  where+    combine ::+      Map IEWrappedNameOrd (LIE GhcPs) ->+      LIE GhcPs ->+      Map IEWrappedNameOrd (LIE GhcPs)+    combine m (L new_l new) =+      let wname = getIewn new+          normalizeWNames =+            nubBy (\x y -> compareLIewn x y == EQ) . sortBy compareLIewn+          alter = \case+            Nothing -> Just . L new_l $+              case new of+                IEThingWith NoExtField n wildcard g flbl ->+                  IEThingWith NoExtField n wildcard (normalizeWNames g) flbl+                other -> other+            Just old ->+              let f = \case+                    IEVar NoExtField n -> IEVar NoExtField n+                    IEThingAbs NoExtField _ -> new+                    IEThingAll NoExtField n -> IEThingAll NoExtField n+                    IEThingWith NoExtField n wildcard g flbl ->+                      case new of+                        IEVar NoExtField _ ->+                          error "Ormolu.Imports broken presupposition"+                        IEThingAbs NoExtField _ ->+                          IEThingWith NoExtField n wildcard g flbl+                        IEThingAll NoExtField n' ->+                          IEThingAll NoExtField n'+                        IEThingWith NoExtField n' wildcard' g' flbl' ->+                          let combinedWildcard =+                                case (wildcard, wildcard') of+                                  (IEWildcard _, _) -> IEWildcard 0+                                  (_, IEWildcard _) -> IEWildcard 0+                                  _ -> NoIEWildcard+                           in IEThingWith+                                NoExtField+                                n'+                                combinedWildcard+                                (normalizeWNames (g <> g'))+                                flbl'+                        IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+                        IEGroup NoExtField _ _ -> notImplemented "IEGroup"+                        IEDoc NoExtField _ -> notImplemented "IEDoc"+                        IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"+                        XIE x -> noExtCon x+                    IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+                    IEGroup NoExtField _ _ -> notImplemented "IEGroup"+                    IEDoc NoExtField _ -> notImplemented "IEDoc"+                    IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"+                    XIE x -> noExtCon x+               in Just (f <$> old)+       in M.alter alter wname m --- | Sort imports\/exports inside of 'IEThingWith'.-sortThings :: IE GhcPs -> IE GhcPs-sortThings = \case-  IEThingWith NoExtField x w xs fl ->-    IEThingWith NoExtField x w (sortBy (compareIewn `on` unLoc) xs) fl-  other -> other+-- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an+-- 'Ord' instance for it.+newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName)+  deriving (Eq) --- | Compare two located imports or exports.-compareIE :: IE GhcPs -> IE GhcPs -> Ordering-compareIE = compareIewn `on` getIewn+instance Ord IEWrappedNameOrd where+  compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y  -- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.-getIewn :: IE GhcPs -> IEWrappedName RdrName+getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case-  IEVar NoExtField x -> unLoc x-  IEThingAbs NoExtField x -> unLoc x-  IEThingAll NoExtField x -> unLoc x-  IEThingWith NoExtField x _ _ _ -> unLoc x+  IEVar NoExtField x -> IEWrappedNameOrd (unLoc x)+  IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x)+  IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x)+  IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x)   IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"   IEGroup NoExtField _ _ -> notImplemented "IEGroup"   IEDoc NoExtField _ -> notImplemented "IEDoc"   IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"   XIE x -> noExtCon x +-- | Like 'compareIewn' for located wrapped names.+compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering+compareLIewn = compareIewn `on` unLoc+ -- | Compare two @'IEWrapppedName' 'RdrName'@ things. compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering-compareIewn (IEName x) (IEName y) = unLoc x `compare` unLoc y+compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y compareIewn (IEName _) (IEPattern _) = LT compareIewn (IEName _) (IEType _) = LT compareIewn (IEPattern _) (IEName _) = GT-compareIewn (IEPattern x) (IEPattern y) = unLoc x `compare` unLoc y+compareIewn (IEPattern x) (IEPattern y) = unLoc x `compareRdrName` unLoc y compareIewn (IEPattern _) (IEType _) = LT compareIewn (IEType _) (IEName _) = GT compareIewn (IEType _) (IEPattern _) = GT-compareIewn (IEType x) (IEType y) = unLoc x `compare` unLoc y+compareIewn (IEType x) (IEType y) = unLoc x `compareRdrName` unLoc y++compareRdrName :: RdrName -> RdrName -> Ordering+compareRdrName x y =+  case (getNameStr x, getNameStr y) of+    ([], []) -> EQ+    ((_ : _), []) -> GT+    ([], (_ : _)) -> LT+    ((x' : _), (y' : _)) ->+      case (isAlphaNum x', isAlphaNum y') of+        (False, False) -> x `compare` y+        (True, False) -> LT+        (False, True) -> GT+        (True, True) -> x `compare` y+  where+    getNameStr = showOutputable . rdrNameOcc

@@ -32,7 +32,7 @@ import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Processing.Preprocess (preprocess)-import Ormolu.Utils (incSpanLine)+import Ormolu.Utils (incSpanLine, removeIndentation) import qualified Panic as GHC import qualified Parser as GHC import qualified StringBuffer as GHC@@ -51,8 +51,9 @@       Either (SrcSpan, String) ParseResult     ) parseModule Config {..} path rawInput = liftIO $ do-  let (literalPrefix, input, literalSuffix, extraComments) =+  let (literalPrefix, indentedInput, literalSuffix, extraComments) =         preprocess path rawInput cfgRegion+      (input, indent) = removeIndentation indentedInput   -- It's important that 'setDefaultExts' is done before   -- 'parsePragmasIntoDynFlags', because otherwise we might enable an   -- extension that was explicitly disabled in the file.@@ -110,7 +111,8 @@                         prImportQualifiedPost =                           GHC.xopt ImportQualifiedPost dynFlags,                         prLiteralPrefix = T.pack literalPrefix,-                        prLiteralSuffix = T.pack literalSuffix+                        prLiteralSuffix = T.pack literalSuffix,+                        prIndent = indent                       }   return (warnings, r) 

@@ -27,7 +27,8 @@ import qualified Lexer as GHC import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang-import Ormolu.Utils (showOutputable)+import Ormolu.Processing.Common+import Ormolu.Utils (onTheSameLine, showOutputable) import SrcLoc  ----------------------------------------------------------------------------@@ -109,11 +110,15 @@             Nothing -> s :| []             Just (x :| xs) ->               let getIndent y =-                    if all isSpace y+                    if all isSpace y || y == endDisabling                       then startIndent                       else length (takeWhile isSpace y)                   n = minimum (startIndent : fmap getIndent xs)-               in x :| (drop n <$> xs)+                  removeIndent y =+                    if y == endDisabling+                      then y+                      else drop n y+               in x :| (removeIndent <$> xs)           else s :| []     (atomsBefore, ls') =       case dropWhile ((< commentLine) . fst) ls of@@ -145,6 +150,7 @@  -- | Detect and extract stack header if it is present. extractStackHeader ::+  -- | Comment stream to analyze   [RealLocated String] ->   ([RealLocated String], Maybe (RealLocated Comment)) extractStackHeader = \case@@ -160,7 +166,9 @@  -- | Extract pragmas and their associated comments. extractPragmas ::+  -- | Input   String ->+  -- | Comment stream to analyze   [RealLocated String] ->   ([RealLocated Comment], [([RealLocated Comment], Pragma)]) extractPragmas input = go initialLs id id@@ -174,8 +182,17 @@             let (ls', x') = mkComment ls x              in go ls' (csSoFar . (x' :)) pragmasSoFar xs           Just pragma ->-            let combined = (csSoFar [], pragma)-             in go ls id (pragmasSoFar . (combined :)) xs+            let combined ys = (csSoFar ys, pragma)+                go' ls' ys rest = go ls' id (pragmasSoFar . (combined ys :)) rest+             in case xs of+                  [] -> go' ls [] xs+                  (y : ys) ->+                    let (ls', y') = mkComment ls y+                     in if onTheSameLine+                          (RealSrcSpan (getRealSrcSpan x))+                          (RealSrcSpan (getRealSrcSpan y))+                          then go' ls' [y'] ys+                          else go' ls [] xs  -- | Get a 'String' from 'GHC.AnnotationComment'. unAnnotationComment :: GHC.AnnotationComment -> Maybe String

@@ -35,7 +35,9 @@     -- | Literal prefix     prLiteralPrefix :: Text,     -- | Literal suffix-    prLiteralSuffix :: Text+    prLiteralSuffix :: Text,+    -- | Indentation level, can be non-zero in case of region formatting+    prIndent :: Int   }  -- | Pretty-print a 'ParseResult'.

@@ -23,7 +23,7 @@   prLiteralPrefix <> region <> prLiteralSuffix   where     region =-      postprocess $+      postprocess prIndent $         runR           ( p_hsModule               prStackHeader

@@ -21,6 +21,7 @@     space,     newline,     inci,+    inciIf,     located,     located',     switchLayout,@@ -51,6 +52,7 @@      -- ** Literals     comma,+    commaDel,     equals,      -- ** Stateful markers@@ -72,6 +74,15 @@ ---------------------------------------------------------------------------- -- Basic +-- | Indent the inner expression if the first argument is 'True'.+inciIf ::+  -- | Whether to indent+  Bool ->+  -- | The expression to indent+  R () ->+  R ()+inciIf b m = if b then inci m else m+ -- | Enter a 'Located' entity. This combinator handles outputting comments -- and sets layout (single-line vs multi-line) for the inner computation. -- Roughly, the rule for using 'located' is that every time there is a@@ -174,10 +185,12 @@         xs' ->           if ub             then do-              txt "{ "-              sep (txt "; ") (dontUseBraces . f) xs'-              txt " }"-            else sep (txt "; ") f xs'+              txt "{"+              space+              sep (txt ";" >> space) (dontUseBraces . f) xs'+              space+              txt "}"+            else sep (txt ";" >> space) f xs'     multiLine =       sep newline (dontUseBraces . f) xs @@ -190,6 +203,7 @@     N   | -- | Shifted one level     S+  deriving (Eq, Show)  -- | Surround given entity by backticks. backticks :: R () -> R ()@@ -266,9 +280,7 @@         then newline >> inci m         else space >> sitcc m       newline-      case style of-        N -> txt close-        S -> inci (txt close)+      inciIf (style == S) (txt close)  ---------------------------------------------------------------------------- -- Literals@@ -276,6 +288,10 @@ -- | Print @,@. comma :: R () comma = txt ","++-- | Delimiting combination with 'comma'. To be used with 'sep'.+commaDel :: R ()+commaDel = comma >> breakpoint  -- | Print @=@. Do not use @'txt' "="@. equals :: R ()

@@ -220,7 +220,8 @@   R () txt = spit SimpleText --- |+-- | Similar to 'txt' but the text inserted this way is assumed to break the+-- “link” between the preceding atom and its pending comments. interferingTxt ::   -- | 'Text' to output   Text ->@@ -243,6 +244,7 @@   -- | 'Text' to output   Text ->   R ()+spit _ "" = return () spit stype text = do   requestedDel <- R (gets scRequestedDelimiter)   pendingComments <- R (gets scPendingComments)

@@ -114,14 +114,14 @@ p_infixDefHelper ::   -- | Whether to format in infix style   Bool ->-  -- | Indentation-bumping wrapper-  (R () -> R ()) ->+  -- | Whether to bump indentation for arguments+  Bool ->   -- | How to print the operator\/name   R () ->   -- | How to print the arguments   [R ()] ->   R ()-p_infixDefHelper isInfix inci' name args =+p_infixDefHelper isInfix indentArgs name args =   case (isInfix, args) of     (True, p0 : p1 : ps) -> do       let parens' =@@ -131,18 +131,18 @@       parens' $ do         p0         breakpoint-        inci $ sitcc $ do+        inci . sitcc $ do           name           space           p1-      unless (null ps) . inci' $ do+      unless (null ps) . inciIf indentArgs $ do         breakpoint         sitcc (sep breakpoint sitcc ps)     (_, ps) -> do       name       unless (null ps) $ do         breakpoint-        inci' $ sitcc (sep breakpoint sitcc args)+        inciIf indentArgs $ sitcc (sep breakpoint sitcc args)  -- | Print a Haddock. p_hsDocString ::

@@ -12,7 +12,7 @@ where  import Data.List (sort)-import Data.List.NonEmpty ((<|), NonEmpty (..))+import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import GHC hiding (InlinePragma) import OccName (occNameFS)@@ -54,12 +54,13 @@ 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) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)+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) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)   where     renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)     renderGroupWithPrev prev curr =@@ -288,9 +289,10 @@ patSigRdrNames _ = Nothing  warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]-warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case-  L _ (Warning NoExtField ns _) -> map unLoc ns-  L _ (XWarnDecl x) -> noExtCon x+warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $+  flip concatMap ws $ \case+    L _ (Warning NoExtField ns _) -> map unLoc ns+    L _ (XWarnDecl x) -> noExtCon x warnSigRdrNames _ = Nothing  patBindNames :: Pat GhcPs -> [RdrName]

@@ -58,7 +58,7 @@       switchLayout signatureSpans $         p_infixDefHelper           (isInfix fixity)-          inci+          True           (p_rdrName name)           (located' p_hsTyVarBndr <$> hsq_explicit)       inci (p_classFundeps fdeps)@@ -82,7 +82,7 @@   breakpoint   txt "|"   space-  sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps+  inci $ sep commaDel (sitcc . located' p_funDep) fdeps  p_funDep :: FunDep (Located RdrName) -> R () p_funDep (before, after) = do

@@ -41,7 +41,7 @@     inci $       p_infixDefHelper         (isInfix fixity)-        inci+        True         (p_rdrName name)         (located' p_hsType <$> tpats)   case dd_kindSig of@@ -60,28 +60,26 @@           txt "where"         breakpoint         sepSemi (located' (p_conDecl False)) dd_cons-      else switchLayout (getLoc name : (getLoc <$> dd_cons))-        $ inci-        $ do-          let singleConstRec = isSingleConstRec dd_cons-          if singleConstRec-            then space-            else-              if hasHaddocks dd_cons-                then newline-                else breakpoint-          equals-          space-          layout <- getLayout-          let s =-                if layout == MultiLine || hasHaddocks dd_cons-                  then newline >> txt "|" >> space-                  else space >> txt "|" >> space-              sitcc' =-                if singleConstRec-                  then id-                  else sitcc-          sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons+      else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do+        let singleConstRec = isSingleConstRec dd_cons+        if singleConstRec+          then space+          else+            if hasHaddocks dd_cons+              then newline+              else breakpoint+        equals+        space+        layout <- getLayout+        let s =+              if layout == MultiLine || hasHaddocks dd_cons+                then newline >> txt "|" >> space+                else space >> txt "|" >> space+            sitcc' =+              if singleConstRec+                then id+                else sitcc+        sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons   unless (null $ unLoc dd_derivs) breakpoint   inci . located dd_derivs $ \xs ->     sep newline (located' p_hsDerivingClause) xs@@ -106,11 +104,10 @@         (c : cs) -> do           p_rdrName c           unless (null cs) . inci $ do-            comma-            breakpoint-            sitcc $ sep (comma >> breakpoint) p_rdrName cs-      space+            commaDel+            sep commaDel p_rdrName cs       inci $ do+        space         txt "::"         let interArgBreak =               if hasDocStrings (unLoc con_res_ty)@@ -158,11 +155,7 @@         RecCon l -> do           p_rdrName con_name           breakpoint-          let inci' =-                if singleConstRec-                  then id-                  else inci-          inci' (located l p_conDeclFields)+          inciIf (not singleConstRec) (located l p_conDeclFields)         InfixCon x y -> do           located x p_hsType           breakpoint@@ -211,9 +204,9 @@   let derivingWhat = located deriv_clause_tys $ \case         [] -> txt "()"         xs ->-          parens N . sitcc $+          parens N $             sep-              (comma >> breakpoint)+              commaDel               (sitcc . located' p_hsType . hsib_body)               xs   space

@@ -15,6 +15,6 @@   DefaultDecl NoExtField ts -> do     txt "default"     breakpoint-    inci . parens N . sitcc $-      sep (comma >> breakpoint) (sitcc . located' p_hsType) ts+    inci . parens N $+      sep commaDel (sitcc . located' p_hsType) ts   XDefaultDecl x -> noExtCon x

@@ -32,9 +32,7 @@         txt "instance"         breakpoint         match_overlap_mode deriv_overlap_mode breakpoint-        if toIndent-          then inci typesAfterInstance-          else typesAfterInstance+        inciIf toIndent typesAfterInstance   txt "deriving"   space   case deriv_strategy of@@ -90,12 +88,10 @@             unless (null allDecls) $ do               breakpoint               txt "where"-        unless (null allDecls)-          $ inci-          $ do-            -- Ensure whitespace is added after where clause.-            breakpoint-            dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls+        unless (null allDecls) . inci $ do+          -- Ensure whitespace is added after where clause.+          breakpoint+          dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls       XHsImplicitBndrs x -> noExtCon x   XClsInstDecl x -> noExtCon x 

@@ -18,7 +18,7 @@ p_ruleDecls :: RuleDecls GhcPs -> R () p_ruleDecls = \case   HsRules NoExtField _ xs ->-    pragma "RULES" . sitcc $+    pragma "RULES" $       sep breakpoint (sitcc . located' p_ruleDecl) xs   XRuleDecls x -> noExtCon x 

@@ -14,7 +14,6 @@ import BasicTypes import BooleanFormula import Control.Monad-import Data.Bool (bool) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common@@ -48,25 +47,22 @@   p_rdrName n   if null ns     then p_typeAscription hswc-    else do-      comma-      breakpoint-      bool id inci indentTail $ do-        sep (comma >> breakpoint) p_rdrName ns-        p_typeAscription hswc+    else inciIf indentTail $ do+      commaDel+      sep commaDel p_rdrName ns+      p_typeAscription hswc  p_typeAscription ::   LHsSigWcType GhcPs ->   R ()-p_typeAscription HsWC {..} = do+p_typeAscription HsWC {..} = inci $ do   space-  inci $ do-    txt "::"-    let t = hsib_body hswc_body-    if hasDocStrings (unLoc t)-      then newline-      else breakpoint-    located t p_hsType+  txt "::"+  let t = hsib_body hswc_body+  if hasDocStrings (unLoc t)+    then newline+    else breakpoint+  located t p_hsType p_typeAscription (XHsWildCardBndrs x) = noExtCon x  p_patSynSig ::@@ -108,7 +104,7 @@     space     atom n     space-    sitcc $ sep (comma >> breakpoint) p_rdrName names+    sitcc $ sep commaDel p_rdrName names   XFixitySig x -> noExtCon x  p_inlineSig ::@@ -147,7 +143,7 @@   space   txt "::"   breakpoint-  inci $ sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts+  inci $ sep commaDel (located' p_hsType . hsib_body) ts  p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case@@ -191,13 +187,13 @@   And xs ->     sitcc $       sep-        (comma >> breakpoint)+        commaDel         (located' p_booleanFormula)         xs   Or xs ->     sitcc $       sep-        (breakpoint >> txt "| ")+        (breakpoint >> txt "|" >> space)         (located' p_booleanFormula)         xs   Parens l -> located l (parens N . p_booleanFormula)@@ -211,7 +207,7 @@ p_completeSig cs' mty =   located cs' $ \cs ->     pragma "COMPLETE" . inci $ do-      sitcc $ sep (comma >> breakpoint) p_rdrName cs+      sep commaDel p_rdrName cs       forM_ mty $ \ty -> do         space         txt "::"@@ -228,12 +224,13 @@ p_standaloneKindSig :: StandaloneKindSig GhcPs -> R () p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do   txt "type"-  space-  p_rdrName name-  space-  txt "::"-  breakpoint-  inci $ case bndrs of-    HsIB NoExtField sig -> located sig p_hsType-    XHsImplicitBndrs x -> noExtCon x+  inci $ do+    space+    p_rdrName name+    space+    txt "::"+    breakpoint+    case bndrs of+      HsIB NoExtField sig -> located sig p_hsType+      XHsImplicitBndrs x -> noExtCon x p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c

@@ -28,7 +28,7 @@   switchLayout (getLoc name : map getLoc hsq_explicit) $     p_infixDefHelper       (case fixity of Infix -> True; _ -> False)-      inci+      True       (p_rdrName name)       (map (located' p_hsTyVarBndr) hsq_explicit)   space

@@ -31,7 +31,7 @@     switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $       p_infixDefHelper         (isInfix fdFixity)-        inci+        True         (p_rdrName fdLName)         (located' p_hsTyVarBndr <$> hsq_explicit)     let resultSig = p_familyResultSigL fdResultSig@@ -92,12 +92,12 @@     Just bndrs -> do       p_forallBndrs ForallInvis p_hsTyVarBndr bndrs       breakpoint-  (if null feqn_bndrs then id else inci) $ do+  inciIf (not $ null feqn_bndrs) $ do     let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats     switchLayout famLhsSpn $       p_infixDefHelper         (isInfix feqn_fixity)-        inci+        True         (p_rdrName feqn_tycon)         (located' p_hsType . typeArgToType <$> feqn_pats)     space

@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}@@ -21,12 +22,12 @@ import Data.Data hiding (Infix, Prefix) import Data.Functor ((<&>)) import Data.List (intersperse, sortOn)-import Data.List.NonEmpty ((<|), NonEmpty (..))+import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import Data.Text (Text) import qualified Data.Text as Text import GHC-import OccName (mkVarOcc)+import OccName (occNameString) import Ormolu.Printer.Combinators import Ormolu.Printer.Internal import Ormolu.Printer.Meat.Common@@ -60,7 +61,7 @@     -- should use it and avoid bumping one level     -- of indentation     Hanging-  deriving (Eq)+  deriving (Eq, Show)  p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_valDecl = \case@@ -179,25 +180,24 @@     NoSrcStrict -> return ()     SrcStrict -> txt "!"     SrcLazy -> txt "~"-  inci' <- case NE.nonEmpty m_pats of-    Nothing -> id <$ case style of-      Function name -> p_rdrName name-      _ -> return ()+  indentBody <- case NE.nonEmpty m_pats of+    Nothing ->+      False <$ case style of+        Function name -> p_rdrName name+        _ -> return ()     Just ne_pats -> do-      let combinedSpans =-            combineSrcSpans' $-              getLoc <$> ne_pats-          inci' =-            if isOneLineSpan combinedSpans-              then id-              else inci+      let combinedSpans = case style of+            Function name -> combineSrcSpans (getLoc name) patSpans+            _ -> patSpans+          patSpans = combineSrcSpans' (getLoc <$> ne_pats)+          indentBody = not (isOneLineSpan combinedSpans)       switchLayout [combinedSpans] $ do         let stdCase = sep breakpoint (located' p_pat) m_pats         case style of           Function name ->             p_infixDefHelper               isInfix-              inci'+              indentBody               (p_rdrName name)               (located' p_pat <$> m_pats)           PatternBind -> stdCase@@ -212,7 +212,7 @@             when needsSpace space             sitcc stdCase           LambdaCase -> stdCase-      return inci'+      return indentBody   let -- Calculate position of end of patterns. This is useful when we decide       -- about putting certain constructions in hanging positions.       endOfPats = case NE.nonEmpty m_pats of@@ -224,7 +224,7 @@         Case -> True         LambdaCase -> True         _ -> False-  let hasGuards = withGuards grhssGRHSs+      hasGuards = withGuards grhssGRHSs       grhssSpan =         combineSrcSpans' $           getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs@@ -253,7 +253,7 @@           txt "where"           unless whereIsEmpty breakpoint           inci $ located grhssLocalBinds p_hsLocalBinds-  inci' $ do+  inciIf indentBody $ do     unless (length grhssGRHSs > 1) $       case style of         Function _ | hasGuards -> return ()@@ -284,7 +284,7 @@     xs -> do       txt "|"       space-      sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)+      sitcc (sep commaDel (sitcc . located' p_stmt) xs)       space       inci $ case style of         EqualSign -> equals@@ -316,7 +316,7 @@         HsHigherOrderApp -> txt "-<<"       placeHanging (exprPlacement (unLoc input)) $         located input p_hsExpr-  HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do+  HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do     located form p_hsExpr     unless (null cmds) $ do       breakpoint@@ -353,7 +353,14 @@   HsCmdTop NoExtField cmd -> located cmd p_hsCmd   XCmdTop x -> noExtCon x -withSpacing :: Data a => (a -> R ()) -> Located a -> R ()+-- | Render an expression preserving blank lines between such consecutive+-- expressions found in the original source code.+withSpacing ::+  -- | Rendering function+  (a -> R ()) ->+  -- | Entity to render+  Located a ->+  R () withSpacing f l = located l $ \x -> do   case getLoc l of     UnhelpfulSpan _ -> f x@@ -464,30 +471,24 @@ p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R () p_hsLocalBinds = \case   HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do-    let ssStart =-          either-            (srcSpanStart . getLoc)-            (srcSpanStart . getLoc)-        items =-          (Left <$> bagToList bag) ++ (Right <$> lsigs)-        p_item (Left x) = located x p_valDecl-        p_item (Right x) = located x p_sigDecl     -- 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-    sitcc $-      sepSemi-        ( \(p, i) ->-            ( case p of-                SinglePos -> id-                FirstPos -> br-                MiddlePos -> br-                LastPos -> id-            )-              (p_item i)-        )-        (attachRelativePos $ sortOn ssStart items)+    let items =+          let injectLeft (L l x) = L l (Left x)+              injectRight (L l x) = L l (Right x)+           in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs)+        positionToBracing = \case+          SinglePos -> id+          FirstPos -> br+          MiddlePos -> br+          LastPos -> id+        p_item' (p, item) =+          positionToBracing p $+            withSpacing (either p_valDecl p_sigDecl) item+        binds = sortOn (srcSpanStart . getLoc) items+    sitcc $ sepSemi p_item' (attachRelativePos binds)   HsValBinds NoExtField _ -> notImplemented "HsValBinds"   HsIPBinds NoExtField (IPBinds NoExtField xs) ->     -- Second argument of IPBind is always Left before type-checking.@@ -520,12 +521,6 @@             else Normal     placeHanging placement (located hsRecFieldArg p_hsExpr) -p_hsTupArg :: HsTupArg GhcPs -> R ()-p_hsTupArg = \case-  Present NoExtField x -> located x p_hsExpr-  Missing NoExtField -> pure ()-  XTupArg x -> noExtCon x- p_hsExpr :: HsExpr GhcPs -> R () p_hsExpr = p_hsExpr' N @@ -589,23 +584,21 @@             -- do-block or case expression it is not a good idea. It seems             -- to be safe to always bump indentation when the function             -- expression is parenthesised.-            indent =+            doIndent =               case func of-                L _ (HsPar NoExtField _) -> inci-                L _ (HsAppType NoExtField _ _) -> inci-                L _ (HsMultiIf NoExtField _) -> inci-                L spn _ ->-                  if isOneLineSpan spn-                    then inci-                    else id-        ub <- getLayout <&> \case-          SingleLine -> useBraces-          MultiLine -> id+                L _ (HsPar NoExtField _) -> True+                L _ (HsAppType NoExtField _ _) -> True+                L _ (HsMultiIf NoExtField _) -> True+                L spn _ -> isOneLineSpan spn+        ub <-+          getLayout <&> \case+            SingleLine -> useBraces+            MultiLine -> id         ub $ do           located func (p_hsExpr' s)           breakpoint-          indent $ sep breakpoint (located' p_hsExpr) initp-        indent $ do+          inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp+        inciIf doIndent $ do           unless (null initp) breakpoint           located lastp p_hsExpr       Hanging -> do@@ -620,10 +613,15 @@     breakpoint     inci $ do       txt "@"+      -- Insert a space when the type is represented as a TH splice to avoid+      -- gluing @ and $ together.+      case unLoc (hswc_body a) of+        HsSpliceTy {} -> space+        _ -> return ()       located (hswc_body a) p_hsType   OpApp NoExtField x op y -> do     let opTree = OpBranch (exprOpTree x) op (exprOpTree y)-    p_exprOpTree True s (reassociateOpTree getOpName opTree)+    p_exprOpTree s (reassociateOpTree getOpName opTree)   NegApp NoExtField e _ -> do     txt "-"     space@@ -640,22 +638,27 @@     let isRecordDot' = isRecordDot (unLoc op) (getLoc x)     unless (useRecordDot' && isRecordDot') breakpoint     inci (located x p_hsExpr)-  ExplicitTuple NoExtField args boxity -> do+  ExplicitTuple NoExtField args boxity ->     let isSection = any (isMissing . unLoc) args         isMissing = \case           Missing NoExtField -> True           _ -> False-    let parens' =+        p_arg = \case+          Present NoExtField x -> located x p_hsExpr+          Missing NoExtField -> pure ()+          XTupArg x -> noExtCon x+        p_larg = sitcc . located' p_arg+        parens' =           case boxity of             Boxed -> parens             Unboxed -> parensHash-    if isSection-      then-        switchLayout [] . parens' s $-          sep comma (located' p_hsTupArg) args-      else-        switchLayout (getLoc <$> args) . parens' s . sitcc $-          sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args+     in if isSection+          then+            switchLayout [] . parens' s $+              sep comma p_larg args+          else+            switchLayout (getLoc <$> args) . parens' s $+              sep commaDel p_larg args   ExplicitSum NoExtField tag arity e ->     p_unboxedSum N tag arity (located e p_hsExpr)   HsCase NoExtField e mgroup ->@@ -665,7 +668,7 @@   HsMultiIf NoExtField guards -> do     txt "if"     breakpoint-    inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards+    inci . inci $ sep newline (located' (p_grhs RightArrow)) guards   HsLet NoExtField localBinds e ->     p_let p_hsExpr localBinds e   HsDo NoExtField ctx es -> do@@ -677,15 +680,15 @@             sepSemi               (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))               (unLoc es)-        compBody = brackets N $ located es $ \xs -> do+        compBody = brackets N . located es $ \xs -> do           let p_parBody =                 sep-                  (breakpoint >> txt "| ")+                  (breakpoint >> txt "|" >> space)                   p_seqBody               p_seqBody =                 sitcc                   . sep-                    (comma >> breakpoint)+                    commaDel                     (located' (sitcc . p_stmt))               stmts = init xs               yield = last xs@@ -706,8 +709,8 @@       ParStmtCtxt _ -> notImplemented "ParStmtCtxt"       TransStmtCtxt _ -> notImplemented "TransStmtCtxt"   ExplicitList _ _ xs ->-    brackets s . sitcc $-      sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs+    brackets s $+      sep commaDel (sitcc . located' p_hsExpr) xs   RecordCon {..} -> do     located rcon_con_name atom     breakpoint@@ -723,8 +726,8 @@           case rec_dotdot of             Just {} -> [txt ".."]             Nothing -> []-    inci . braces N . sitcc $-      sep (comma >> breakpoint) sitcc (fields <> dotdot)+    inci . braces N $+      sep commaDel sitcc (fields <> dotdot)   RecordUpd {..} -> do     located rupd_expr p_hsExpr     useRecordDot' <- useRecordDot@@ -742,9 +745,9 @@                 Unambiguous _ n -> n                 XAmbiguousFieldOcc x -> noExtCon x             }-    inci . braces N . sitcc $+    inci . braces N $       sep-        (comma >> breakpoint)+        commaDel         (sitcc . located' (p_hsRecField . updName))         rupd_flds   ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do@@ -757,22 +760,22 @@   ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x   ArithSeq NoExtField _ x ->     case x of-      From from -> brackets s . sitcc $ do+      From from -> brackets s $ do         located from p_hsExpr         breakpoint         txt ".."-      FromThen from next -> brackets s . sitcc $ do-        sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]+      FromThen from next -> brackets s $ do+        sep commaDel (located' p_hsExpr) [from, next]         breakpoint         txt ".."-      FromTo from to -> brackets s . sitcc $ do+      FromTo from to -> brackets s $ do         located from p_hsExpr         breakpoint         txt ".."         space         located to p_hsExpr-      FromThenTo from next to -> brackets s . sitcc $ do-        sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]+      FromThenTo from next to -> brackets s $ do+        sep commaDel (located' p_hsExpr) [from, next]         breakpoint         txt ".."         space@@ -849,8 +852,8 @@       inci $ do         switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do           unless (null xs) breakpoint-          braces N . sitcc $-            sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs+          braces N $+            sep commaDel (p_rdrName . recordPatSynPatVar) xs         rhs     InfixCon l r -> do       switchLayout [getLoc l, getLoc r] $ do@@ -946,13 +949,13 @@     txt "!"     located pat p_pat   ListPat NoExtField pats ->-    brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats+    brackets S $ sep commaDel (located' p_pat) pats   TuplePat NoExtField pats boxing -> do-    let f =+    let parens' =           case boxing of             Boxed -> parens S             Unboxed -> parensHash S-    f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats+    parens' $ sep commaDel (sitcc . located' p_pat) pats   SumPat NoExtField pat tag arity ->     p_unboxedSum S tag arity (located pat p_pat)   ConPatIn pat details ->@@ -968,7 +971,7 @@         let f = \case               Nothing -> txt ".."               Just x -> located x p_pat_hsRecField-        inci . braces N . sitcc . sep (comma >> breakpoint) f $+        inci . braces N . sep commaDel f $           case dotdot of             Nothing -> Just <$> fields             Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]@@ -1018,17 +1021,15 @@   let before = tag - 1       after = arity - before - 1       args = replicate before Nothing <> [Just m] <> replicate after Nothing-      f (x, i) = do-        let isFirst = i == 0-            isLast = i == arity - 1+      f x =         case x :: Maybe (R ()) of           Nothing ->-            unless (isFirst || isLast) space+            space           Just m' -> do-            unless isFirst space+            space             m'-            unless isLast space-  parensHash s $ sep (txt "|") f (zip args [0 ..])+            space+  parensHash s $ sep (txt "|") f args  p_hsSplice :: HsSplice GhcPs -> R () p_hsSplice = \case@@ -1230,11 +1231,10 @@   HsCase NoExtField _ _ -> Hanging   HsDo NoExtField DoExpr _ -> Hanging   HsDo NoExtField MDoExpr _ -> 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.-  OpApp NoExtField _ _ y -> exprPlacement (unLoc y)-  -- Same thing for function applications (usually with -XBlockArguments)+  OpApp NoExtField _ op y ->+    case (fmap getOpNameStr . getOpName . unLoc) op of+      Just "$" -> exprPlacement (unLoc y)+      _ -> Normal   HsApp NoExtField _ y -> exprPlacement (unLoc y)   HsProc NoExtField p _ ->     -- Indentation breaks if pattern is longer than one line and left@@ -1260,15 +1260,16 @@   HsVar NoExtField (L _ a) -> Just a   _ -> Nothing +getOpNameStr :: RdrName -> String+getOpNameStr = occNameString . rdrNameOcc+ p_exprOpTree ::-  -- | Can use special handling of dollar?-  Bool ->   -- | Bracket style to use   BracketStyle ->   OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) ->   R ()-p_exprOpTree _ s (OpNode x) = located x (p_hsExpr' s)-p_exprOpTree isDollarSpecial s (OpBranch x op y) = do+p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)+p_exprOpTree s (OpBranch x op y) = do   -- 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.@@ -1290,44 +1291,54 @@         MultiLine -> case placement of           Hanging -> useBraces           Normal -> dontUseBraces-      gotDollar = case getOpName (unLoc op) of-        Just rname -> mkVarOcc "$" == rdrNameOcc rname-        _ -> False+      opNameStr = (fmap getOpNameStr . getOpName . unLoc) op+      gotDollar = opNameStr == Just "$"+      gotColon = opNameStr == Just ":"+      gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y)       lhs =         switchLayout [opTreeLoc x] $-          p_exprOpTree (not gotDollar) s x-  let p_op = located op (opWrapper . p_hsExpr)-      p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)+          p_exprOpTree s x+      p_op = located op (opWrapper . p_hsExpr)+      p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y)       isSection = case (opTreeLoc x, getLoc op) of         (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->           srcSpanEndCol treeSpan /= srcSpanStartCol opSpan         _ -> False+      isDoBlock = \case+        OpNode (L _ HsDo {}) -> True+        _ -> False   useRecordDot' <- useRecordDot-  let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)-  if useRecordDot' && isRecordDot'-    then do-      lhs-      when isSection space-      p_op-      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+  if+      | gotColon -> do+        lhs+        space+        p_op+        case placement of+          Hanging -> do             space             p_y+          Normal -> do+            breakpoint+            inciIf (isDoBlock y) p_y+      | gotDollar+          && isOneLineSpan (opTreeLoc x)+          && placement == Normal -> do+        useBraces lhs+        space+        p_op+        breakpoint+        inci p_y+      | useRecordDot' && gotRecordDot -> do+        lhs+        when isSection space+        p_op+        p_y+      | otherwise -> do+        ub lhs+        placeHanging placement $ do+          p_op+          space+          p_y  -- | Return 'True' if given expression is a record-dot operator expression. isRecordDot ::@@ -1338,13 +1349,9 @@   Bool isRecordDot op (RealSrcSpan ySpan) = case op of   HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->-    isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)+    (getOpNameStr 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]

@@ -32,10 +32,9 @@ p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () p_topLevelWarning fnames wtxt = do   let (pragmaText, lits) = warningText wtxt-  switchLayout (fmap getLoc fnames ++ fmap getLoc lits)-    $ pragma pragmaText . inci-    $ do-      sitcc $ sep (comma >> breakpoint) p_rdrName fnames+  switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $+    pragma pragmaText . inci $ do+      sep commaDel p_rdrName fnames       breakpoint       p_lits lits @@ -47,4 +46,4 @@ p_lits :: [Located StringLiteral] -> R () p_lits = \case   [l] -> atom l-  ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls+  ls -> brackets N $ sep commaDel atom ls

@@ -21,7 +21,7 @@   breakpoint'   txt ")" p_hsmodExports xs =-  parens N . sitcc $ do+  parens N $ do     layout <- getLayout     sep       breakpoint@@ -65,7 +65,7 @@       Nothing -> return ()       Just (_, L _ xs) -> do         breakpoint-        parens N . sitcc $ do+        parens N $ do           layout <- getLayout           sep             breakpoint@@ -93,9 +93,8 @@     inci $ do       let names :: [R ()]           names = located' p_ieWrappedName <$> xs-      parens N . sitcc-        $ sep (comma >> breakpoint) sitcc-        $ case w of+      parens N . sep commaDel sitcc $+        case w of           NoIEWildcard -> names           IEWildcard n ->             let (before, after) = splitAt n names

@@ -11,7 +11,7 @@ import Control.Monad import qualified Data.Text as T import GHC-import Ormolu.Imports+import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang@@ -69,7 +69,7 @@         txt "where"         newline     newline-    forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))+    forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost))     newline     switchLayout (getLoc <$> hsmodDecls) $ do       p_hsDecls Free hsmodDecls

@@ -67,7 +67,7 @@             L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)             _ -> (f', knownArgs)         (func, args) = gatherArgs f [x]-    switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do+    switchLayout (getLoc f : fmap getLoc args) . sitcc $ do       located func p_hsType       breakpoint       inci $@@ -98,10 +98,9 @@             HsBoxedTuple -> parens N             HsConstraintTuple -> parens N             HsBoxedOrConstraintTuple -> parens N-     in parens' . sitcc $-          sep (comma >> breakpoint) (sitcc . located' p_hsType) xs+     in parens' $ sep commaDel (sitcc . located' p_hsType) xs   HsSumTy NoExtField xs ->-    parensHash N . sitcc $+    parensHash N $       sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs   HsOpTy NoExtField x op y ->     sitcc $@@ -118,9 +117,9 @@   HsStarTy NoExtField _ -> txt "*"   HsKindSig NoExtField t k -> sitcc $ do     located t p_hsType-    space -- FIXME-    txt "::"     space+    txt "::"+    breakpoint     inci (located k p_hsType)   HsSpliceTy NoExtField splice -> p_hsSplice splice   HsDocTy NoExtField t str ->@@ -154,14 +153,14 @@       case (p, xs) of         (IsPromoted, L _ t : _) | isPromoted t -> space         _ -> return ()-      sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs+      sep commaDel (sitcc . located' p_hsType) xs   HsExplicitTupleTy NoExtField xs -> do     txt "'"     parens N $ do       case xs of         L _ t : _ | isPromoted t -> space         _ -> return ()-      sep (comma >> breakpoint) (located' p_hsType) xs+      sep commaDel (located' p_hsType) xs   HsTyLit NoExtField t ->     case t of       HsStrTy (SourceText s) _ -> p_stringLit s@@ -192,9 +191,7 @@ p_hsContext = \case   [] -> txt "()"   [x] -> located x p_hsType-  xs ->-    parens N . sitcc $-      sep (comma >> breakpoint) (sitcc . located' p_hsType) xs+  xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs  p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R () p_hsTyVarBndr = \case@@ -224,15 +221,14 @@  p_conDeclFields :: [LConDeclField GhcPs] -> R () p_conDeclFields xs =-  braces N . sitcc $-    sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs+  braces N $ sep commaDel (sitcc . located' p_conDeclField) xs  p_conDeclField :: ConDeclField GhcPs -> R () p_conDeclField ConDeclField {..} = do   mapM_ (p_hsDocString Pipe True) cd_fld_doc   sitcc $     sep-      (comma >> breakpoint)+      commaDel       (located' (p_rdrName . rdrNameFieldOcc))       cd_fld_names   space@@ -274,6 +270,6 @@     -- <https://gitlab.haskell.org/ghc/ghc/issues/17404>. This is fine as     -- long as 'tyVarToType' does not get applied to right-hand sides of     -- declarations.-    HsParTy NoExtField $ noLoc $+    HsParTy NoExtField . noLoc $       HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind   XTyVarBndr x -> noExtCon x

@@ -16,7 +16,7 @@ import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe) import GHC-import OccName (mkVarOcc)+import OccName (occNameString) import Ormolu.Utils (unSrcSpan)  -- | Intermediate representation of operator trees. It has two type@@ -57,7 +57,7 @@ reassociateOpTreeWith ::   forall ty op.   -- | Fixity map for operators-  Map RdrName Fixity ->+  Map String Fixity ->   -- | How to get the name of an operator   (op -> Maybe RdrName) ->   -- | Original 'OpTree'@@ -68,8 +68,8 @@   where     fixityOf :: op -> Fixity     fixityOf op = fromMaybe defaultFixity $ do-      opName <- getOpName op-      M.lookup opName fixityMap+      s <- occNameString . rdrNameOcc <$> getOpName op+      M.lookup s 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.@@ -112,26 +112,26 @@   -- | Operator tree   OpTree (Located ty) (Located op) ->   -- | Fixity map-  Map RdrName Fixity+  Map String Fixity buildFixityMap getOpName opTree =   addOverrides     . M.fromList     . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)-    . zip [1 ..]+    . zip [2 ..]     . L.groupBy ((==) `on` snd)     . selectScores     $ score opTree   where-    addOverrides :: Map RdrName Fixity -> Map RdrName Fixity+    addOverrides :: Map String Fixity -> Map String Fixity     addOverrides m =-      let mk k v = (mkRdrUnqual (mkVarOcc k), fixity v InfixL)-       in M.fromList-            [ mk "$" 0,-              mk "." 9-            ]-            `M.union` m+      M.fromList+        [ ("$", fixity 0 InfixR),+          (":", fixity 1 InfixR),+          (".", fixity 100 InfixL)+        ]+        `M.union` m     fixity = Fixity NoSourceText-    score :: OpTree (Located ty) (Located op) -> [(RdrName, Score)]+    score :: OpTree (Located ty) (Located op) -> [(String, 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@@ -141,13 +141,13 @@       oe <- srcSpanEndLine <$> unSrcSpan (getLoc o) -- operator end       rb <- srcSpanStartLine <$> unSrcSpan (opTreeLoc r) -- right begin       oc <- srcSpanStartCol <$> unSrcSpan (getLoc o) -- operator column-      opName <- getOpName (unLoc o)+      opName <- occNameString . rdrNameOcc <$> getOpName (unLoc o)       let s             | le < ob = AtBeginning oc             | oe < rb = AtEnd             | otherwise = InBetween       return $ (opName, s) : score r-    selectScores :: [(RdrName, Score)] -> [(RdrName, Score)]+    selectScores :: [(String, Score)] -> [(String, Score)]     selectScores =       L.sortOn snd         . mapMaybe

@@ -20,7 +20,7 @@  -- | Marker for the beginning of the region where Ormolu should be disabled. startDisabling :: IsString s => s-startDisabling = "{- ORMOLU_DISABLING_START"+startDisabling = "{- ORMOLU_DISABLE_START"  -- | Marker for the end of the region where Ormolu should be disabled. endDisabling :: IsString s => s

@@ -1,3 +1,6 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+ -- | Postprocessing for the results of printing. module Ormolu.Processing.Postprocess   ( postprocess,@@ -10,12 +13,19 @@ import qualified Ormolu.Processing.Cpp as Cpp  -- | Postprocess output of the formatter.-postprocess :: Text -> Text-postprocess =+postprocess ::+  -- | Desired indentation level+  Int ->+  -- | Input to process+  Text ->+  Text+postprocess indent =   T.unlines+    . fmap indentLine     . fmap Cpp.unmaskLine     . filter (not . magicComment)     . T.lines   where-    magicComment x =+    magicComment (T.stripStart -> x) =       x == startDisabling || x == endDisabling+    indentLine x = T.replicate indent " " <> x

@@ -11,8 +11,7 @@ import Control.Monad import Data.Char (isSpace) import qualified Data.List as L-import Data.Maybe (isJust)-import Data.Maybe (maybeToList)+import Data.Maybe (isJust, maybeToList) import FastString import Ormolu.Config (RegionDeltas (..)) import Ormolu.Parser.Shebang (isShebang)@@ -143,7 +142,8 @@   -- | Whether or not the two strings watch   Bool magicComment expected s0 = isJust $ do-  s1 <- dropWhile isSpace <$> L.stripPrefix "{-" s0-  s2 <- dropWhile isSpace <$> L.stripPrefix expected s1+  let trim = dropWhile isSpace+  s1 <- trim <$> L.stripPrefix "{-" (trim s0)+  s2 <- trim <$> L.stripPrefix expected s1   s3 <- L.stripPrefix "-}" s2   guard (all isSpace s3)

@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}  -- | Random utilities used by the code. module Ormolu.Utils@@ -15,12 +16,14 @@     separatedByBlank,     separatedByBlankNE,     onTheSameLine,+    removeIndentation,   ) where +import Data.Char (isSpace) import Data.List (dropWhileEnd)-import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T@@ -139,3 +142,14 @@ onTheSameLine :: SrcSpan -> SrcSpan -> Bool onTheSameLine a b =   isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))++-- | Remove indentation from a given 'String'. Return the input with+-- indentation removed and the detected indentation level.+removeIndentation :: String -> (String, Int)+removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n)+  where+    n = minimum (getIndent <$> xs)+    getIndent y =+      if all isSpace y+        then 0+        else length (takeWhile isSpace y)