packages feed

fourmolu 0.1.0.0 → 0.2.0.0

raw patch · 458 files changed

+5365/−1176 lines, 458 filesdep +HsYAMLdep +HsYAML-aesondep −yamldep ~dlistdep ~optparse-applicativePVP ok

version bump matches the API change (PVP)

Dependencies added: HsYAML, HsYAML-aeson

Dependencies removed: yaml

Dependency ranges changed: dlist, optparse-applicative

API changes (from Hackage documentation)

- Ormolu: [poIndentStep] :: PrinterOpts -> Int
- Ormolu.Config: [poIndentStep] :: PrinterOpts -> Int
- Ormolu.Config: instance GHC.Classes.Eq Ormolu.Config.PrinterOpts
- Ormolu.Config: instance GHC.Generics.Generic Ormolu.Config.PrinterOptsPartial
- Ormolu.Config: instance GHC.Show.Show Ormolu.Config.PrinterOpts
- Ormolu.Imports: sortImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs]
- Ormolu.Printer: [poIndentStep] :: PrinterOpts -> Int
- Ormolu.Printer.Meat.Common: p_hsDocName :: String -> R ()
+ Ormolu: ConfigLoaded :: FilePath -> PrinterOptsPartial -> ConfigFileLoadResult
+ Ormolu: ConfigNotFound :: [FilePath] -> ConfigFileLoadResult
+ Ormolu: ConfigParseError :: FilePath -> (Pos, String) -> ConfigFileLoadResult
+ Ormolu: [poCommaStyle] :: PrinterOpts f -> f CommaStyle
+ Ormolu: [poDiffFriendlyImportExport] :: PrinterOpts f -> f Bool
+ Ormolu: [poHaddockStyle] :: PrinterOpts f -> f HaddockPrintStyle
+ Ormolu: [poIndentWheres] :: PrinterOpts f -> f Bool
+ Ormolu: [poIndentation] :: PrinterOpts f -> f Int
+ Ormolu: [poRecordBraceSpace] :: PrinterOpts f -> f Bool
+ Ormolu: [poRespectful] :: PrinterOpts f -> f Bool
+ Ormolu: configFileName :: FilePath
+ Ormolu: data ConfigFileLoadResult
+ Ormolu: fillMissingPrinterOpts :: forall f. Applicative f => PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
+ Ormolu: type PrinterOptsPartial = PrinterOpts Maybe
+ Ormolu: type PrinterOptsTotal = PrinterOpts Identity
+ Ormolu.Config: ConfigLoaded :: FilePath -> PrinterOptsPartial -> ConfigFileLoadResult
+ Ormolu.Config: ConfigNotFound :: [FilePath] -> ConfigFileLoadResult
+ Ormolu.Config: ConfigParseError :: FilePath -> (Pos, String) -> ConfigFileLoadResult
+ Ormolu.Config: HaddockMultiLine :: HaddockPrintStyle
+ Ormolu.Config: HaddockSingleLine :: HaddockPrintStyle
+ Ormolu.Config: Leading :: CommaStyle
+ Ormolu.Config: Trailing :: CommaStyle
+ Ormolu.Config: [poCommaStyle] :: PrinterOpts f -> f CommaStyle
+ Ormolu.Config: [poDiffFriendlyImportExport] :: PrinterOpts f -> f Bool
+ Ormolu.Config: [poHaddockStyle] :: PrinterOpts f -> f HaddockPrintStyle
+ Ormolu.Config: [poIndentWheres] :: PrinterOpts f -> f Bool
+ Ormolu.Config: [poIndentation] :: PrinterOpts f -> f Int
+ Ormolu.Config: [poRecordBraceSpace] :: PrinterOpts f -> f Bool
+ Ormolu.Config: [poRespectful] :: PrinterOpts f -> f Bool
+ Ormolu.Config: configFileName :: FilePath
+ Ormolu.Config: data CommaStyle
+ Ormolu.Config: data ConfigFileLoadResult
+ Ormolu.Config: data HaddockPrintStyle
+ Ormolu.Config: fillMissingPrinterOpts :: forall f. Applicative f => PrinterOptsPartial -> PrinterOpts f -> PrinterOpts f
+ Ormolu.Config: instance Data.Aeson.Types.FromJSON.FromJSON Ormolu.Config.CommaStyle
+ Ormolu.Config: instance Data.Aeson.Types.FromJSON.FromJSON Ormolu.Config.HaddockPrintStyle
+ Ormolu.Config: instance GHC.Base.Monoid Ormolu.Config.PrinterOptsPartial
+ Ormolu.Config: instance GHC.Base.Semigroup Ormolu.Config.PrinterOptsPartial
+ Ormolu.Config: instance GHC.Classes.Eq Ormolu.Config.CommaStyle
+ Ormolu.Config: instance GHC.Classes.Eq Ormolu.Config.ConfigFileLoadResult
+ Ormolu.Config: instance GHC.Classes.Eq Ormolu.Config.HaddockPrintStyle
+ Ormolu.Config: instance GHC.Classes.Eq Ormolu.Config.PrinterOptsTotal
+ Ormolu.Config: instance GHC.Classes.Ord Ormolu.Config.CommaStyle
+ Ormolu.Config: instance GHC.Classes.Ord Ormolu.Config.HaddockPrintStyle
+ Ormolu.Config: instance GHC.Generics.Generic (Ormolu.Config.PrinterOpts f)
+ Ormolu.Config: instance GHC.Generics.Generic Ormolu.Config.CommaStyle
+ Ormolu.Config: instance GHC.Generics.Generic Ormolu.Config.HaddockPrintStyle
+ Ormolu.Config: instance GHC.Show.Show Ormolu.Config.CommaStyle
+ Ormolu.Config: instance GHC.Show.Show Ormolu.Config.ConfigFileLoadResult
+ Ormolu.Config: instance GHC.Show.Show Ormolu.Config.HaddockPrintStyle
+ Ormolu.Config: instance GHC.Show.Show Ormolu.Config.PrinterOptsTotal
+ Ormolu.Config: type PrinterOptsPartial = PrinterOpts Maybe
+ Ormolu.Config: type PrinterOptsTotal = PrinterOpts Identity
+ Ormolu.Imports: instance GHC.Classes.Eq Ormolu.Imports.IEWrappedNameOrd
+ Ormolu.Imports: instance GHC.Classes.Eq Ormolu.Imports.ImportId
+ Ormolu.Imports: instance GHC.Classes.Ord Ormolu.Imports.IEWrappedNameOrd
+ Ormolu.Imports: instance GHC.Classes.Ord Ormolu.Imports.ImportId
+ Ormolu.Imports: normalizeImports :: Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]
+ Ormolu.Parser.Result: [prIndent] :: ParseResult -> Int
+ Ormolu.Printer: [poCommaStyle] :: PrinterOpts f -> f CommaStyle
+ Ormolu.Printer: [poDiffFriendlyImportExport] :: PrinterOpts f -> f Bool
+ Ormolu.Printer: [poHaddockStyle] :: PrinterOpts f -> f HaddockPrintStyle
+ Ormolu.Printer: [poIndentWheres] :: PrinterOpts f -> f Bool
+ Ormolu.Printer: [poIndentation] :: PrinterOpts f -> f Int
+ Ormolu.Printer: [poRecordBraceSpace] :: PrinterOpts f -> f Bool
+ Ormolu.Printer: [poRespectful] :: PrinterOpts f -> f Bool
+ Ormolu.Printer.Combinators: commaDel :: R ()
+ Ormolu.Printer.Combinators: getPrinterOpt :: (forall f. PrinterOpts f -> f a) -> R a
+ Ormolu.Printer.Combinators: inciBy :: Int -> R () -> R ()
+ Ormolu.Printer.Combinators: inciIf :: Bool -> R () -> R ()
+ Ormolu.Printer.Combinators: instance GHC.Classes.Eq Ormolu.Printer.Combinators.BracketStyle
+ Ormolu.Printer.Combinators: instance GHC.Show.Show Ormolu.Printer.Combinators.BracketStyle
+ Ormolu.Printer.Internal: getPrinterOpt :: (forall f. PrinterOpts f -> f a) -> R a
+ Ormolu.Printer.Internal: inciBy :: Int -> R () -> R ()
+ Ormolu.Printer.Meat.Declaration.Value: instance GHC.Show.Show Ormolu.Printer.Meat.Declaration.Value.Placement
+ Ormolu.Printer.Meat.ImportExport: breakIfNotDiffFriendly :: R ()
+ Ormolu.Utils: groupBy' :: (a -> a -> Bool) -> [a] -> [NonEmpty a]
+ Ormolu.Utils: removeIndentation :: String -> (String, Int)
- Ormolu: Config :: ![DynOption] -> !Bool -> !Bool -> !Bool -> !region -> PrinterOpts -> Config region
+ Ormolu: Config :: ![DynOption] -> !Bool -> !Bool -> !Bool -> !region -> !PrinterOptsTotal -> Config region
- Ormolu: PrinterOpts :: Int -> PrinterOpts
+ Ormolu: PrinterOpts :: f Int -> f CommaStyle -> f Bool -> f Bool -> f Bool -> f Bool -> f HaddockPrintStyle -> PrinterOpts f
- Ormolu: [cfgPrinterOpts] :: Config region -> PrinterOpts
+ Ormolu: [cfgPrinterOpts] :: Config region -> !PrinterOptsTotal
- Ormolu: data PrinterOpts
+ Ormolu: data PrinterOpts f
- Ormolu: defaultPrinterOpts :: PrinterOpts
+ Ormolu: defaultPrinterOpts :: PrinterOptsTotal
- Ormolu: loadConfigFile :: Bool -> Maybe FilePath -> PrinterOpts -> IO PrinterOpts
+ Ormolu: loadConfigFile :: FilePath -> IO ConfigFileLoadResult
- Ormolu.Config: Config :: ![DynOption] -> !Bool -> !Bool -> !Bool -> !region -> PrinterOpts -> Config region
+ Ormolu.Config: Config :: ![DynOption] -> !Bool -> !Bool -> !Bool -> !region -> !PrinterOptsTotal -> Config region
- Ormolu.Config: PrinterOpts :: Int -> PrinterOpts
+ Ormolu.Config: PrinterOpts :: f Int -> f CommaStyle -> f Bool -> f Bool -> f Bool -> f Bool -> f HaddockPrintStyle -> PrinterOpts f
- Ormolu.Config: [cfgPrinterOpts] :: Config region -> PrinterOpts
+ Ormolu.Config: [cfgPrinterOpts] :: Config region -> !PrinterOptsTotal
- Ormolu.Config: data PrinterOpts
+ Ormolu.Config: data PrinterOpts f
- Ormolu.Config: defaultPrinterOpts :: PrinterOpts
+ Ormolu.Config: defaultPrinterOpts :: PrinterOptsTotal
- Ormolu.Config: loadConfigFile :: Bool -> Maybe FilePath -> PrinterOpts -> IO PrinterOpts
+ Ormolu.Config: loadConfigFile :: FilePath -> IO ConfigFileLoadResult
- Ormolu.Parser.Result: ParseResult :: HsModule GhcPs -> Anns -> Maybe (RealLocated Comment) -> [Shebang] -> [([RealLocated Comment], Pragma)] -> CommentStream -> Bool -> Bool -> Text -> Text -> ParseResult
+ Ormolu.Parser.Result: ParseResult :: HsModule GhcPs -> Anns -> Maybe (RealLocated Comment) -> [Shebang] -> [([RealLocated Comment], Pragma)] -> CommentStream -> Bool -> Bool -> Text -> Text -> Int -> ParseResult
- Ormolu.Printer: PrinterOpts :: Int -> PrinterOpts
+ Ormolu.Printer: PrinterOpts :: f Int -> f CommaStyle -> f Bool -> f Bool -> f Bool -> f Bool -> f HaddockPrintStyle -> PrinterOpts f
- Ormolu.Printer: data PrinterOpts
+ Ormolu.Printer: data PrinterOpts f
- Ormolu.Printer: printModule :: ParseResult -> PrinterOpts -> Text
+ Ormolu.Printer: printModule :: ParseResult -> PrinterOptsTotal -> Text
- Ormolu.Printer.Combinators: runR :: R () -> SpanStream -> CommentStream -> Anns -> PrinterOpts -> Bool -> Text
+ Ormolu.Printer.Combinators: runR :: R () -> SpanStream -> CommentStream -> Anns -> PrinterOptsTotal -> Bool -> Text
- Ormolu.Printer.Internal: runR :: R () -> SpanStream -> CommentStream -> Anns -> PrinterOpts -> Bool -> Text
+ Ormolu.Printer.Internal: runR :: R () -> SpanStream -> CommentStream -> Anns -> PrinterOptsTotal -> Bool -> Text
- Ormolu.Printer.Meat.Common: p_infixDefHelper :: Bool -> (R () -> R ()) -> R () -> [R ()] -> R ()
+ Ormolu.Printer.Meat.Common: p_infixDefHelper :: Bool -> Bool -> R () -> [R ()] -> R ()
- Ormolu.Processing.Postprocess: postprocess :: Text -> Text
+ Ormolu.Processing.Postprocess: postprocess :: Int -> Text -> Text

Files

CHANGELOG.md view
@@ -1,10 +1,90 @@+## Fourmolu 0.2.0.0++* More consistent indentation. Previously, with indentation set to n, some constructs such as nested lists and tuples would use an ugly mix of n-space and 2-space indentation.++* New configuration options (see README or Hackage docs for details):+  * `comma-style`+  * `record-brace-space`+  * `indent-wheres`+  * `diff-friendly-import-export`+  * `respectful`+  * `haddock-style`++### Upstream changes:++#### Ormolu 0.1.3.0:++* Ormolu no longer overwrites already formatted files. [PR+  649](https://github.com/tweag/ormolu/pull/649).++* Now a space is guaranteed before ticked promoted types. [Issue+  631](https://github.com/tweag/ormolu/issues/631).++* Made formatting of single-line explicitly bidirectional pattern synonyms+  idempotent. [Issue 630](https://github.com/tweag/ormolu/issues/630).++#### Ormolu 0.1.2.0:++* Fixed the bug when comments in different styles got glued together after+  formatting. [Issue 589](https://github.com/tweag/ormolu/issues/589).++* Added `-i` as a shortcut for `--mode inplace`. [Issue+  467](https://github.com/tweag/ormolu/issues/467).++* Improved grouping of top-level declarations. [Issue+  466](https://github.com/tweag/ormolu/issues/466).++## Fourmolu 0.1.1.0++### Upstream changes:++#### 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).+ ## Fourmolu 0.1.0.0  * Allow configuration of indentation size via `fourmolu.yaml` config files.  * An operator on a new line is no longer indented when its left operand is a do-block. This prevents the AST from potentially changing when indenting by more than two spaces. -Upstream changes:+### Upstream changes:++#### Ormolu 0.1.0.0:  * Fixed rendering of type signatures concerning several identifiers. [Issue   566](https://github.com/tweag/ormolu/issues/566).
− CONTRIBUTING.md 
@@ -1,64 +0,0 @@-# Contributing--Issues (bugs, feature requests or otherwise feedback) may be reported in-[the GitHub issue tracker for this project][issues]. Pull requests are also-welcome.--When contributing to this repository, please first discuss the change you-wish to make via an issue, unless it's entirely trivial (typo fixes, etc.).-If there is already an issue that describes the change you have in mind,-comment on it indicating that you're going to work on that. This way we can-avoid the situation when several people work on the same thing.--Please make sure that all non-trivial changes are described in commit-messages and PR descriptions.--## What to hack on?--* [Fixing bugs][bugs]. This is the main focus right now.--### Testing--Testing has been taken good care of and now it amounts to just adding-examples under `data/examples`. Each example is a pair of files:-`<example-name>.hs` for input and `<example-name>-out.hs` for corresponding-expected output.--Testing is performed as following:--* Given snippet of source code is parsed and pretty-printed.-* 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.-* 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-inspiration.--Please note that we try to keep individual files at most 25 lines long-because otherwise it's hard to figure out want went wrong when a test fails.--## CI--We use Circle CI. Some outside contributors may have problems, as in, CI-won't run for PRs opened from forks with “unauthorized” errors. In that case-the best we can do is to add you as a contributor or to restart your build-manually.--If you have been added as a contributor but the builds still do not start,-try clicking--```-User settings -> Account integrations -> Refresh permissions-```--in Circle CI app.--## Formatting--Use `format.sh` script to format Ormolu with current version of Ormolu. If-Ormolu is not formatted like this, the CI will fail.--[issues]: https://github.com/tweag/ormolu/issues-[bugs]: https://github.com/tweag/ormolu/issues?q=is%3Aissue+is%3Aopen+label%3Abug
− DESIGN.md 
@@ -1,407 +0,0 @@-# Ormolu--*This document represents our discussions and plans at early stages of-development, it is no longer being updated.*--* [Analysis of the existing solutions](#analysis-of-the-existing-solutions)-    * [Brittany](#brittany)-    * [Hindent](#hindent)-    * [Stylish Haskell](#stylish-haskell)-    * [Haskell formatter](#haskell-formatter)-* [Proposed design](#proposed-design)-    * [Parsing](#parsing)-    * [CPP](#cpp)-    * [Printing](#printing)-    * [Configuration](#configuration)-    * [Handling of language extensions](#handling-of-language-extensions)-    * [Testing](#testing)-    * [Functionality of executable](#functionality-of-executable)-    * [Why not contribute to/fork Hindent or Brittany?](#why-not-contribute-tofork-hindent-or-brittany)-* [Examples](#examples)--This document describes design of a new formatter for Haskell source code.-It also includes recommendations for future implementers.--We set for the following goals (mostly taken from-[brittany](https://github.com/lspitzner/brittany)):-* 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;-* Be idempotent.--## Analysis of the existing solutions--In order to design a new formatter we need to study the existing solutions-so we can borrow the good bits and avoid making the same mistakes.--### Brittany--[Brittany][brittany] builds on top of [`ghc-exactprint`][ghc-exactprint]—a-library that uses parser of GHC itself for parsing and thus it guarantees-that at least parsing phase is bug-free (which is admittedly the cause of-majority of bugs in other projects, see below).--After parsing, Haskell AST and a collection of annotations are available.-The annotations are there because Haskell AST doesn't provide enough-information to reconstruct source code (for example it doesn't include-comments). The AST and the annotations are converted into a `BriDoc` value.-A `BriDoc` value is a document representation like the `Doc` from the-[pretty][pretty-doc] or the [wl-pprint][wl-pprint-doc] libraries.--Brittany implements its own document type in an attempt to find a-satisfactory rendering of the source code that fits a page-width-constraint. Because of this, a `BriDoc` value represents a collection-of many candidate layouts (i.e. renderings) of the source code.--This collection is pruned until it contains a single layout. The-structure of the chosen layout is then adjusted to leave it in a-form which can be easily traversed to produce the final rendering.--Brittany invests the majority of its implementation to manage-the `BriDoc` values. Given that the amount of possible layouts is-exponential, the representation is clever enough to fit them in-linear space. There are multiple ways to build a `BriDoc`, not all-of which fit in linear space. So care is necessary to keep memory-bounded.--The compexities of the `BriDoc` structure, together with the lack of-documentation, make Brittany at least challenging to maintain.--### Hindent--[Hindent][hindent] uses [`haskell-src-exts`][haskell-src-exts] for parsing-like all older projects. `haskell-src-exts` does not use parser of GHC-itself, and is a source of endless parsing bugs. `Hindent` is affected by-these upstream issues as well as Stylish Haskell and Haskell formatter (see-below). This already makes all these projects unusable with some valid-Haskell source code, but let's continue studying Hindent anyway.--Hindent is quite different from Brittany in the sense that it does not-attempt to build a document representation to render-afterwards, instead it just prints the parsed code straight away. This means-that the 70-80% of what the code does is a printing traversal.--Hindent code is easier to read and debug. Pretty-printing functions are-very straightforward. If there is a bug (in pretty-printer, not in parser-which Hindent cannot control), it's easy to fix AFAIU.--Hindent is also notable for its ability to handle CPP and inputs that do not-constitute complete modules. It splits input stream into so-called “code-blocks” recognizing CPP macros and then only pretty-prints “normal code”-without touching CPP directives. After that CPP is inserted between-pretty-printed blocks of source code. The approach fails when CPP breaks-code in such a way that separate blocks do not form valid Haskell-expressions, see-[this](https://github.com/commercialhaskell/hindent/issues/383) for example.--Looking at the bug tracker there are many bugs. Part of them is because of-the use of `haskell-src-exts`, the other part is because the maintainer-doesn't care (anymore?) and doesn't fix them. Well it's as simple as that,-with any sort of commercial backing the bugs in pretty printer would be-fixed long time ago.--### Stylish Haskell--[Stylish Haskell][stylish-haskell] also uses `haskell-src-exts` and suffers-from the same upstream problems. I haven't studied the transformations it-performs, but it looks like it transforms the parsed source code partially-by manipulating AST and partially by manipulating raw text (e.g. to drop-trailing whitspace from each line). CPP Macros are just filtered out-silently as a preprocessing step before feeding the code to-`haskell-src-exts`.--Stylish Haskell is not so invasive as the other formatters and most reported-bugs are about parsing issues and CPP. As I understand it, people mostly use-it to screw their import lists.--### Haskell formatter--[Haskell formatter][haskell-formatter] is an older project that didn't get-much traction. It also uses `haskell-src-ext` and also tries to do-manipulations on the parsed AST. The issue tracker doesn't have many issues-probably because it never got popular enough (only 15 stars on GitHub). All-the issues are about upstream problems with `haskell-src-exts`.--## Proposed design--This section describes a solution that combines all the good things from the-projects above.--### Parsing and CPP--It is clear that `ghc-exactprint` is better than `haskell-src-exts`, so we-should use that. If we go with `ghc-exactprint` though, we'll need to-specify which parser to use, e.g. the parser that parses whole module or the-one which parsers declarations/expressions/etc. It seems that in general-it's better to use the parser for modules because it should work with all-input files containing complete modules, while with other parsers it's-impossible to guess what they'll be called on.--### CPP--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:--* GHC parser won't accept anything but a valid, complete module. Therefore,-  formatting the Haskell code between CPP directives is not an option.--* Ignoring the CPP directives and formatting the Haskell code can change-  its meaning. An example follows.--Let's suppose that we want to format the following program:--```-$ cat test.hs-{-# LANGUAGE CPP #-}-main = print (g && f1)-  where-        f1 = h-          where-            h = True-#ifdef C1-g = g1-  where-    g1 = g2-      where-        g2 = False-#else-        g = True-#endif--#ifndef C1-g = False-#endif--$ runhaskell test.hs-True-```--At the time of this writing, formatting this program with Hindent-or Ormolu produces the same output we would get if the CPP directives-were considered comments:--```-$ ormolu --version-ormolu 0.0.5.0 HEAD fc64eada5c4da7a5b07d2872e253671b48aec115-using ghc-lib-parser 8.10.1.20200412--$ ormolu --mode inplace test.hs--$ cat test.hs-{-# LANGUAGE CPP #-}--main = print (g && f1)-  where-    f1 = h-      where-        h = True-#ifdef C1-g = g1-  where-    g1 = g2-      where-        g2 = False-#else-        g = True-#endif--#ifndef C1-g = False-#endif--$ runhaskell test.hs-False-```--Running the formatter causes the output of the program to change-from `True` to `False` when `C1` is not defined.--A solution could be to make the formatter more careful with CPP-directives, constraining how directives can be inserted in Haskell-code to avoid changing the meaning by reformatting. But-this would introduce additional complexity, and the problem would-need to be solved repeteadly for every tool out there which wants-to parse Haskell modules. If CPP is replaced with some language-extension or mechanism to do conditional compilation, all tools-will benefit from it.--### Printing--Just pretty-printing code (following the approach of Hindent) seems sane. It-is straightforward and when complemented with enough tests (see the section-about testing below), it should work all right.--Implementation can be just a `Reader` monad producing something like text-builder. The context of `Reader` can store current indentation and-configuration options.--As the pretty-printing library we can use [`Outputable`][outputable] (and-`SDoc`) from the [`ghc`][ghc] package itself (at least for pretty-printing-basic things like floating point literals and the like). The benefit is that-AST components that we'll want to print are already instances of-`Outputable`, so we'll get correct renderings for free.--In order to keep the output of the formatter simple, fast and correct,-we introduce the following rule. The pretty-printing code can be in-control of every formatting choice, except for two, which are left to-the programmer:--1. location of comments (comments are going to be attached to specific-   syntactic entities, so moving an entity will move its comment too),-2. line breaking.--Regarding (2), the idea is that given any syntactic entity, the programmer-has a choice:--1. write it on one line, or-2. write it on two lines or more.--If (1), then everything is kept in one line. If (2), i.e. a line break appears-somewhere in the concrete syntax tree (CST), then additional line breaks are-introduced everywhere possible in parent nodes, *but not in any sibling or-children nodes*.--Examples:--```haskell--- Stays as is.-data T = A | B--data T-  = A | B--- Is reformatted to:-data T-  = A-  | B---- Stays as is.-map :: (a -> b) -> [a] -> [b]--foldr :: (a -> b -> b) ->-  b -> [a] -> [b]--- Is reformatted to:-foldr ::-  (a -> b -> b) ->-  b ->-  [a] ->-  [b]--t = let x = foo bar-                      baz-  in foo bar baz--- Is reformatted to:-t =-  let x =-        foo-          bar-          baz-   in foo far baz-```--Crucially, no effort is made to fit within reasonable line lengths. That's-up to the programmer. Style will still be consistent for everyone in every-other aspect, and that's what counts.--### Configuration--We are not allowing to configure any aspect of the formatter. A module-might be used in multiple projects, and we prefer to have it formatted-the same in all of them.--See this [this-post][hindent-5-blog] by Chris Done (the author of Hindent) which says that-as long as the default style is conventional and good it doesn't really-matter how code gets formatted. Consistency is more important.--### Handling of language extensions--Some language extensions affect how parsing is done. We are going to deal-with those in two ways:--* When language pragmas are present in source file, we must parse them-  before we run the main parser (I guess) and they should determine how the-  main parsing will be done.-* There also should be configuration file that may enable other language-  extensions to be used on all files.-* Later we could try to locate Cabal files and fetch the list of extensions-  that are enabled by default from there.--### Testing--It should be possible to add tests incrementally as we develop-pretty-printing code and new issues are discovered. For each Haskell-module that we want to test, we perform the following steps:--1. Given input snippet of source code parse it and pretty print it.-2. Parse the result of pretty-printing again and make sure that AST is the-   same as AST of original snippet module span positions. We could make-   this part of a self-check in the formatter.-3. Check the output against expected output. Thus all tests should include-   two files: input and expected output.-4. Check that running the formatter on the output produces the same output-   again (the transformation is idempotent).--In order to grow our testsuite, we would borrow test cases from test-suites of existing libraries like Brittany and Hindent.-Then we may add test cases for opened issues that Brittany and Hindent have.--When we're confident enough, we can start “mining” new issues by running-the program on real source code from Hackage till we don't get new issues-anymore. For every issue that we find this way, a test case should be added.--### Functionality of executable--* In all cases the program should test if the produced AST is the same as-  the one we originally parsed and if it differs, an error should be-  displayed suggesting reporting this on our issue tracker.-* Check mode: return non-zero exit code if any transformations would be-  applied.-* Modification in place and printing of formatted code to stdout.-* A flag for version/commit information.-* An option to specify location of config file.-* Options to specify parameters that come from config files on command line-  instead (currently this is just dynamic options enabled by default, such-  as langauge extensions).--### Why not contribute to/fork HIndent or Brittany?--We want to simultaneously optimize three goals:--1. simplicity of implementation,-2. efficiency,-3. predictable and readable output that doesn't overuse vertical spacing.--Hindent aims for (1) and (2) by still producing something palatable in (3).-Brittany gives up on-(1) but goes a long way towards (3) and presumably does OK on (2). Ormolu-goes for (1), (2) and (3), by outsourcing the hard part of (3) to the user.-Ormolu is less normative than Brittany, and less normative than Hindent,-but arguably stills achieves consistent style.--Forking or contributing to Hindent is not an option because if we replace-`haskell-src-exts` with `ghc` (or `ghc-exact-print`) then we'll have to work-with a different AST type and all the code in Hindent will become-incompatible and there won't be much code to be re-used in that case. It is-also possible that we'll find a nicer way to write pretty-printer.--## Examples--A list of formatting examples can be found [here](data/examples).--[brittany]: https://hackage.haskell.org/package/brittany-[hindent]: https://hackage.haskell.org/package/hindent-[hindent-5-blog]: https://chrisdone.com/posts/hindent-5-[stylish-haskell]: https://hackage.haskell.org/package/stylish-haskell-[haskell-formatter]: https://hackage.haskell.org/package/haskell-formatter-[ghc]: https://hackage.haskell.org/package/ghc-[outputable]: https://hackage.haskell.org/package/ghc-8.4.3/docs/Outputable.html-[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts-[ghc-exactprint]: https://hackage.haskell.org/package/ghc-exactprint-[hindent-printer]: https://github.com/commercialhaskell/hindent/blob/master/src/HIndent/Pretty.hs-[pretty-doc]: http://hackage.haskell.org/package/pretty-1.1.3.6/docs/Text-PrettyPrint.html#t:Doc-[wl-pprint-doc]: http://hackage.haskell.org/package/wl-pprint-1.2.1/docs/Text-PrettyPrint-Leijen.html#t:Doc
README.md view
@@ -1,16 +1,14 @@-# ~~Ormolu~~ Fourmolu+# Fourmolu  [![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause)-[![Hackage](https://img.shields.io/hackage/v/ormolu.svg?style=flat)](https://hackage.haskell.org/package/ormolu)-[![Stackage Nightly](http://stackage.org/package/ormolu/badge/nightly)](http://stackage.org/nightly/package/ormolu)-[![Stackage LTS](http://stackage.org/package/ormolu/badge/lts)](http://stackage.org/lts/package/ormolu)-[![Build status](https://badge.buildkite.com/8e3b0951f3652b77e1c422b361904136a539b0522029156354.svg?branch=master)](https://buildkite.com/tweag-1/ormolu)+[![Hackage](https://img.shields.io/hackage/v/fourmolu.svg?style=flat)](https://hackage.haskell.org/package/fourmolu) -~~Ormolu~~ Fourmolu is a formatter for Haskell source code. The project was created with-the following goals in mind:+Fourmolu is a formatter for Haskell source code. It is a fork of [Ormolu](https://github.com/tweag/ormolu), with the intention to continue to merge upstream improvements. +We share all bar one of Ormolu's goals:+ * Using GHC's own parser to avoid parsing problems caused by-  [`haskell-src-exts`][haskell-src-exts].+  [`haskell-src-exts`](https://hackage.haskell.org/package/haskell-src-exts). * Let some whitespace be programmable. The layout of the input influences   the layout choices in the output. This means that the choices between   single-line/multi-line layouts in each particular situation are made by@@ -18,154 +16,108 @@   leaves some control to the user while still guaranteeing that the   formatted code is stylistically consistent. * Writing code in such a way so it's easy to modify and maintain.-* Implementing one “true” formatting style ~~which admits no configuration~~ requires you to fork the project to configure it (TODO: add a config file). * That formatting style aims to result in minimal diffs while still   remaining very close to “conventional” Haskell formatting people use. * Choose a style compatible with modern dialects of Haskell. As new Haskell-  extensions enter broad use, we may change the style to accomodate them.+  extensions enter broad use, we may change the style to accommodate them. * Idempotence: formatting already formatted code doesn't change it. * Be well-tested and robust to the point that it can be used in large   projects without exposing unfortunate, disappointing bugs here and there.--## Building--The easiest way to build the project is with Nix:+* ~~Implementing one “true” formatting style which admits no configuration.~~ We allow configuration of various parameters, via CLI options or config files. We encourage any contributions which add further flexibility. -```console-$ nix-build -A ormolu-```+## Configuration -Or with `cabal-install` from the Nix shell:+Fourmolu looks for a `fourmolu.yaml` file in all parents of the current directory, followed by [the XDG config directory](https://hackage.haskell.org/package/directory/docs/System-Directory.html#v:XdgConfig). A complete configuration file, corresponding to Fourmolu's default options, looks like: -```console-$ nix-shell --run "cabal new-build"+```yaml+indentation: 4+comma-style: leading # for lists, tuples etc. - can also be 'trailing'+record-brace-space: false # rec {x = 1} vs. rec{x = 1}+indent-wheres: false # 'false' means save space by only half-indenting the 'where' keyword+diff-friendly-import-export: true # 'false' uses Ormolu-style lists+respectful: true # don't be too opinionated about newlines etc.+haddock-style: multi-line # '--' vs. '{-' ``` -Alternatively, `stack` could be used with a `stack.yaml` file as follows.--```console-$ cat stack.yaml-resolver: lts-14.3-packages:-- '.'+See [here](fourmolu.yaml) for a config to simulate the behaviour of Ormolu. -$ stack build-```+These options can also be set on the command line (which takes precedence over config files). Run `fourmolu -h` to see all options. -To use Ormolu directly from GitHub with Nix, this snippet may come in handy:+## Building -```nix-# This overlay adds Ormolu straight from GitHub.-self: super:+Simply run `cabal v2-install fourmolu`, to install the latest release from Hackage. -let source = super.fetchFromGitHub {-      owner = "tweag";-      repo = "ormolu";-      rev = "de279d80122b287374d4ed87c7b630db1f157642"; # update as necessary-      sha256 = "0qrxfk62ww6b60ha9sqcgl4nb2n5fhf66a65wszjngwkybwlzmrv"; # as well-    };-    ormolu = import source { pkgs = self; };-in {-  haskell = super.haskell // {-    packages = super.haskell.packages // {-      "${ormolu.ormoluCompiler}" = super.haskell.packages.${ormolu.ormoluCompiler}.override {-        overrides = ormolu.ormoluOverlay;-      };-    };-  };-}-```+You can also clone this repository, then build with Cabal or Stack.  ## Usage  The following will print the formatted output to the standard output.  ```console-$ ormolu Module.hs+$ fourmolu Module.hs ``` -Add `--mode inplace` to replace the contents of the input file with the-formatted output.+Add `-i` (or `--mode inplace`) to replace the contents of the input file with the formatted output.  ```console-$ ormolu --mode inplace Module.hs+$ fourmolu -i Module.hs ```  Use `find` to format a tree recursively:  ```console-$ ormolu --mode inplace $(find . -name '*.hs')+$ fourmolu -i $(find . -name '*.hs') ``` +Fourmolu can be integrated with your editor via the [Haskell Language Server](https://github.com/haskell/haskell-language-server).+ ## Magic comments -Ormolu understands two magic comments:+Fourmolu understands two magic comments:  ```haskell-{- ORMOLU_DISABLE -}+{- FOURMOLU_DISABLE -} ```  and  ```haskell-{- ORMOLU_ENABLE -}+{- FOURMOLU_ENABLE -} ```  This allows us to disable formatting selectively for code between these markers or disable it for the entire file. To achieve the latter, just put-`{- ORMOLU_DISABLE -}` at the very top. Note that the source code should-still be parseable even without the “excluded” part. Because of that the-magic comments cannot be placed arbitrary, but should rather enclose-independent top-level definitions.+`{- FOURMOLU_DISABLE -}` at the very top. Note that for Fourmolu to work the+source code must still be parseable even when the disabled regions are+omitted. Because of that the magic comments cannot be placed arbitrarily,+but rather must enclose independent top-level definitions. +`{- ORMOLU_DISABLE -}` and `{- ORMOLU_ENABLE -}`, respectively, can be used to the same effect.+ ## Current limitations  * 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 surround top-level-  declarations. See the [CPP][design-cpp] section in the design notes for+  declarations. See the [CPP](https://github.com/tweag/ormolu/blob/master/DESIGN.md#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.--## Editor integration--We know of the following editor integrations:--* [Emacs][emacs-package]-* [VS Code][vs-code-plugin]-* vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu]--## Running on Hackage--It's possible to try Ormolu on arbitrary packages from Hackage. For that-execute (from the root of the cloned repo):--```console-$ nix-build -A hackage.<package>-```--Then inspect `result/log.txt` for possible problems. The derivation will-also contain formatted `.hs` files for inspection and original inputs with-`.hs-original` extension (those are with CPP dropped, exactly what is fed-into Ormolu).+* Fourmolu is in a fairly early stage of development. The implementation should be as stable as Ormolu, as it only makes minimal changes, and is extensively tested. But the default configuration style may change in some minor ways in the near future, as we make more options available. It will always be possible to replicate the old default behaviour with a suitable `fourmolu.yaml`.  ## Contributing -See [CONTRIBUTING.md][contributing].+If there are any options you'd like to see, let us know. If it's not too complicated to implement (and especially if you implement it yourself!) then we'll probably add it. +Run `cabal test` and `./format.sh` before submitting any pull requests.+ ## License -See [LICENSE.md][license].+See [LICENSE.md](LICENSE.md). -Copyright © 2018–present Tweag I/O+Copyright © 2018–2020 Tweag I/O, 2020-present Matt Parsons -[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-[emacs-package]: https://github.com/vyorkin/ormolu.el-[vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode-[vim-ormolu]: https://github.com/sdiehl/vim-ormolu-[neoformat]: https://github.com/sbdchd/neoformat+## Acknowledgements++The vast majority of work here has been done by the Ormolu developers, and thus they deserve almost all of the credit. This project is simply intended as a haven for those of us who admire their work, but can't quite get on board with some of their decisions when it comes down to the details.
app/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-}@@ -8,36 +9,45 @@  import Control.Exception (SomeException, displayException, try) import Control.Monad+import Data.Bool (bool)+import Data.Char (toLower) import Data.Either (lefts) import Data.List (intercalate, sort)+import Data.Maybe (fromMaybe) import qualified Data.Text.IO as TIO import Data.Version (showVersion) import Development.GitRev import Options.Applicative import Ormolu+import Ormolu.Config import Ormolu.Parser (manualExts) import Ormolu.Utils (showOutputable) import Paths_fourmolu (version)+import System.Directory (getCurrentDirectory) import System.Exit (ExitCode (..), exitWith) import System.IO (hPutStrLn, stderr)  -- | Entry point of the program. main :: IO () main = withPrettyOrmoluExceptions $ do-  Opts {..} <- execParser optsParserInfo-  let formatOne' path = do-        printerOpts <--          loadConfigFile (cfgDebug optConfig) path $ cfgPrinterOpts optConfig-        formatOne optMode optConfig {cfgPrinterOpts = printerOpts} path+  opts@Opts {..} <- execParser optsParserInfo+  let formatStdIn = do+        cur <- getCurrentDirectory+        cfg <- mkConfig cur opts+        formatOne optMode cfg Nothing   case optInputFiles of-    [] -> formatOne' Nothing-    ["-"] -> formatOne' Nothing-    [x] -> formatOne' (Just x)-    xs -> do+    [] -> formatStdIn+    ["-"] -> formatStdIn+    [x] -> flip (formatOne optMode) (Just x) =<< mkConfig x opts+    xs@(x : _) -> do+      cfg <- mkConfig x opts       -- It is possible to get IOException, error's and 'OrmoluException's       -- from 'formatOne', so we just catch everything.       errs <--        lefts <$> mapM (try @SomeException . formatOne' . Just) (sort xs)+        lefts+          <$> mapM+            (try @SomeException . formatOne optMode cfg . Just)+            (sort xs)       unless (null errs) $ do         mapM_ (hPutStrLn stderr . displayException) errs         exitWith (ExitFailure 102)@@ -63,15 +73,19 @@         -- 101 is different from all the other exit codes we already use.         exitWith (ExitFailure 101)   Just inputFile -> do-    r <- ormoluFile config inputFile+    originalInput <- TIO.readFile inputFile+    formattedInput <- ormoluFile config inputFile     case mode of       Stdout ->-        TIO.putStr r-      InPlace ->-        TIO.writeFile inputFile r+        TIO.putStr formattedInput+      InPlace -> do+        -- Only write when the contents have changed, in order to avoid+        -- updating the modified timestamp if the file was already correctly+        -- formatted.+        when (formattedInput /= originalInput) $+          TIO.writeFile inputFile formattedInput       Check -> do-        r' <- TIO.readFile inputFile-        when (r /= r') $+        when (formattedInput /= originalInput) $           -- 100 is different to all the other exit code that are emitted           -- either from an 'OrmoluException' or from 'error' and           -- 'notImplemented'.@@ -85,6 +99,8 @@     optMode :: !Mode,     -- | Ormolu 'Config'     optConfig :: !(Config RegionIndices),+    -- | Fourmolu-specific options+    optPrinterOpts :: !PrinterOptsPartial,     -- | Haskell source files to format or stdin (when the list is empty)     optInputFiles :: ![FilePath]   }@@ -119,7 +135,7 @@       intercalate         "\n"         [ unwords-            [ "ormolu",+            [ "fourmolu",               showVersion version,               $gitBranch,               $gitHash@@ -137,14 +153,20 @@ optsParser :: Parser Opts optsParser =   Opts-    <$> (option parseMode . mconcat)-      [ long "mode",-        short 'm',-        metavar "MODE",-        value Stdout,-        help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"-      ]+    <$> ( (fmap (bool Stdout InPlace) . switch . mconcat)+            [ short 'i',+              help "A shortcut for --mode inplace"+            ]+            <|> (option parseMode . mconcat)+              [ long "mode",+                short 'm',+                metavar "MODE",+                value Stdout,+                help "Mode of operation: 'stdout' (default), 'inplace', or 'check'"+              ]+        )     <*> configParser+    <*> printerOptsParser     <*> (many . strArgument . mconcat)       [ metavar "FILE",         help "Haskell source files to format or stdin (default)"@@ -188,6 +210,56 @@         )     <*> pure defaultPrinterOpts +printerOptsParser :: Parser PrinterOptsPartial+printerOptsParser = do+  poIndentation <-+    (optional . option auto . mconcat)+      [ long "indentation",+        metavar "WIDTH",+        help "Number of spaces per indentation step (default 4)"+      ]+  poCommaStyle <-+    (optional . option parseCommaStyle . mconcat)+      [ long "comma-style",+        metavar "STYLE",+        help "How to place commas in multi-line lists, records etc: 'leading' (default) or 'trailing'"+      ]+  poIndentWheres <-+    (optional . option parseBool . mconcat)+      [ long "indent-wheres",+        metavar "BOOL",+        help $+          "Whether to indent 'where' bindings past the preceding body"+            <> " (rather than half-indenting the 'where' keyword) (default 'false')"+      ]+  poRecordBraceSpace <-+    (optional . option parseBool . mconcat)+      [ long "record-brace-space",+        metavar "BOOL",+        help "Whether to leave a space before an opening record brace (default 'false')"+      ]+  poDiffFriendlyImportExport <-+    (optional . option parseBool . mconcat)+      [ long "diff-friendly-import-export",+        metavar "BOOL",+        help $+          "Whether to make use of extra commas in import/export lists"+            <> " (as opposed to Ormolu's style) (default 'true')"+      ]+  poRespectful <-+    (optional . option parseBool . mconcat)+      [ long "respectful",+        metavar "BOOL",+        help "Give the programmer more choice on where to insert blank lines (default 'true')"+      ]+  poHaddockStyle <-+    (optional . option parseHaddockStyle . mconcat)+      [ long "haddock-style",+        metavar "STYLE",+        help "How to print Haddock comments (default 'multi-line')"+      ]+  pure PrinterOpts {..}+ ---------------------------------------------------------------------------- -- Helpers @@ -198,3 +270,57 @@   "inplace" -> Right InPlace   "check" -> Right Check   s -> Left $ "unknown mode: " ++ s++-- | Parse 'CommaStyle'.+parseCommaStyle :: ReadM CommaStyle+parseCommaStyle = eitherReader $ \case+  "leading" -> Right Leading+  "trailing" -> Right Trailing+  s -> Left $ "unknown comma style: " ++ s++-- | Parse 'HaddockStyle'.+parseHaddockStyle :: ReadM HaddockPrintStyle+parseHaddockStyle = eitherReader $ \case+  "single-line" -> Right HaddockSingleLine+  "multi-line" -> Right HaddockMultiLine+  s -> Left $ "unknown haddock style: " ++ s++-- | Parse a 'Bool'. Unlike 'auto', this is not case sensitive.+parseBool :: ReadM Bool+parseBool = eitherReader $ \x -> case map toLower x of+  "false" -> Right False+  "true" -> Right True+  s -> Left $ "not a boolean value: " ++ s++-- | Build the full config, by adding 'PrinterOpts' from a file, if found.+mkConfig :: FilePath -> Opts -> IO (Config RegionIndices)+mkConfig path Opts {..} = do+  filePrinterOpts <-+    loadConfigFile path >>= \case+      ConfigLoaded f po -> do+        hPutStrLn stderr $ "Loaded config from: " <> f+        printDebug $ show po+        return $ Just po+      ConfigParseError f (_pos, err) -> do+        -- we ignore '_pos' due to the note on 'Data.YAML.Aeson.decode1'+        hPutStrLn stderr $+          unlines+            [ "Failed to load " <> f <> ":",+              "  " <> err+            ]+        exitWith $ ExitFailure 400+      ConfigNotFound searchDirs -> do+        printDebug+          . unlines+          $ ("No " ++ show configFileName ++ " found in any of:") :+          map ("  " ++) searchDirs+        return Nothing+  return $+    optConfig+      { cfgPrinterOpts =+          fillMissingPrinterOpts+            (optPrinterOpts <> fromMaybe mempty filePrinterOpts)+            (cfgPrinterOpts optConfig)+      }+  where+    printDebug = when (cfgDebug optConfig) . hPutStrLn stderr
+ data/examples/declaration/annotation/annotation-four-out.hs view
@@ -0,0 +1,22 @@+{-# ANN module (5 :: Int) #-}++{-# ANN+    module+    ( 5 ::+        Int+    )+    #-}++{-# ANN foo "hey" #-}+foo :: Int+foo = 5++{-# ANN+    Char+    (Just 42)+    #-}++data Foo = Foo Int+{-# ANN type Foo ("HLint: ignore") #-}++{- Comment -}
+ data/examples/declaration/class/associated-data1-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}++class Foo a where data FooBar a++-- | Something.+class Bar a where+    -- | Bar bar+    data BarBar a++    -- | Bar baz+    data+        BarBaz+            a
+ data/examples/declaration/class/associated-data2-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TypeFamilies #-}++module Main where++-- | Something more.+class Baz a where+    -- | Baz bar+    data+        BazBar+            a+            b+            c++    -- | Baz baz+    data+        BazBaz+            b+            a+            c
+ data/examples/declaration/class/associated-type-defaults-four-out.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TypeFamilies #-}++class Foo a where type FooBar a = Int++-- | Something.+class Bar a where+    -- Define bar+    type+        BarBar a =+            BarBaz a++    -- Define baz+    type+        BarBaz+            a =+            BarBar -- Middle comment+                a++class Baz a where+    type+        BazBar+            a++    type+        BazBar a =+            Bar a
+ data/examples/declaration/class/associated-types1-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}++class Foo a where type FooBar a++-- | Something.+class Bar a where+    -- | Bar bar+    type BarBar a++    -- | Bar baz+    type+        BarBaz+            a
+ data/examples/declaration/class/associated-types2-four-out.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE TypeFamilies #-}++module Main where++-- | Something more.+class Baz a where+    -- | Baz bar+    type+        BazBar+            a -- Foo+            b -- Bar+            c++    -- | Baz baz+    type+        -- After type+        BazBaz+            b+            a+            c
+ data/examples/declaration/class/default-implementations-comments-four-out.hs view
@@ -0,0 +1,26 @@+module Main where++-- | Baz+class Baz a where+    foobar :: a -> a+    foobar a =+        barbaz (bazbar a)++    -- | Bar baz+    barbaz ::+        a -> a++    -- | Baz bar+    bazbar ::+        a ->+        a++    -- First comment+    barbaz a =+        bazbar -- Middle comment+            a++    -- Last comment+    bazbar a =+        barbaz+            a
+ data/examples/declaration/class/default-implementations-four-out.hs view
@@ -0,0 +1,13 @@+module Main where++-- | Foo+class Foo a where+    foo :: a -> a+    foo a = a++-- | Bar+class Bar a where+    bar ::+        a ->+        Int+    bar = const 0
+ data/examples/declaration/class/default-signatures-four-out.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DefaultSignatures #-}++module Main where++-- | Something else.+class Bar a where+    -- | Bar+    bar ::+        String ->+        String ->+        a+    -- Pointless comment+    default bar ::+        ( Read a+        , Semigroup a+        ) =>+        a ->+        a ->+        a+    -- Even more pointless comment+    bar+        a+        b =+            read a <> read b
+ data/examples/declaration/class/default-signatures-simple-four-out.hs view
@@ -0,0 +1,8 @@+module Main where++-- | Something.+class Foo a where+    -- | Foo+    foo :: a -> String+    default foo :: Show a => a -> String+    foo = show
+ data/examples/declaration/class/dependency-super-classes-four-out.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE FunctionalDependencies #-}++module Main where++-- | Something.+class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where+    get :: m s+    put :: s -> m ()++-- | 'MonadParsec'+class+    ( Stream s -- Token streams+    , MonadPlus m -- Potential for failure+    ) =>+    MonadParsec e s m+        | m -> e s+    where+    -- | 'getState' returns state+    getState ::+        m s++    -- | 'putState' sets state+    putState ::+        s ->+        m ()
+ data/examples/declaration/class/empty-classes-four-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Foo!+class Foo a++-- | Bar!+class Bar a
+ data/examples/declaration/class/functional-dependencies-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE FunctionalDependencies #-}++module Main where++-- | Something.+class Foo a b | a -> b++class Bar a b | a -> b, b -> a where bar :: a++-- | Something else.+class+    Baz a b c d+        | a b -> c d -- Foo+        , b c -> a d -- Bar+        , a c -> b d -- Baz+        , a c d -> b+        , a b d -> a b c d+    where+    baz :: a -> b
+ data/examples/declaration/class/multi-parameters1-four-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE MultiParamTypeClasses #-}++class Foo a b where foo :: a -> b++-- | Something.+class Bar a b c d where+    bar ::+        a ->+        b ->+        c ->+        d++class -- Before name+    Baz where+    baz :: Int
+ data/examples/declaration/class/multi-parameters2-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE MultiParamTypeClasses #-}++module Main where++-- | Something else.+class+    BarBaz+        a -- Foo+        b -- Bar+        c -- Baz bar+        d -- Baz baz+        e -- Rest+        f+    where+    barbaz ::+        a -> f+    bazbar ::+        e ->+        f
+ data/examples/declaration/class/newlines-after-where-four-out.hs view
@@ -0,0 +1,5 @@+class Num a where+    (+) :: a -> a -> a++class Num a where+    (+) :: a -> a -> a
+ data/examples/declaration/class/newlines-and-default-decls-four-out.hs view
@@ -0,0 +1,11 @@+class Foo a where+    foo :: a+    default foo :: ()+    foo = ()+    bar :: a+    default bar :: ()+    bar = ()++    qux :: a+    default qux :: ()+    qux = ()
+ data/examples/declaration/class/newlines-and-haddocks-four-out.hs view
@@ -0,0 +1,23 @@+class Foo a where+    -- | Haddock+    foo :: a++    -- | Another Haddock+    bar :: a++    baz :: a+    -- ^ Post-Haddock++    raz :: a+    -- ^ Another Post-Haddock++    -- | One more Haddock+    qux :: a++    -- Comment before a Haddock++    -- | And one more Haddock+    xyz :: a++    -- | Haddock followed by a blank line+    abc :: a
+ data/examples/declaration/class/newlines-between-methods-four-out.hs view
@@ -0,0 +1,17 @@+class Num a where+    (+) :: a -> a -> a+    (-) :: a -> a -> a+    (*) :: a -> a -> a++    -- Comment before definition+    negate :: a -> a++    -- Comment after definition++    -- Separator++    abs :: a -> a+    signum :: a -> a++    -- Comment between unrelated definitions+    fromInteger :: Integer -> a
+ data/examples/declaration/class/poly-kinded-classes-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE PolyKinds #-}++class Foo (a :: k)++class+    Bar+        ( a :: -- Variable+            * -- Star+        )
+ data/examples/declaration/class/single-parameters-four-out.hs view
@@ -0,0 +1,26 @@+module Main where++-- | Something.+class Foo a where foo :: a++-- | Something more.+class Bar a where+    -- | Bar+    bar :: a -> a -> a++class Baz a where+    -- | Baz+    baz ::+        -- | First argument+        ( a+        , a+        ) ->+        -- | Second argument+        a ->+        -- | Return value+        a++class BarBaz a where+    barbaz ::+        a -> b+    bazbar :: b -> a
+ data/examples/declaration/class/super-classes-four-out.hs view
@@ -0,0 +1,11 @@+class Foo a+class Foo a => Bar a+class+    (Foo a, Bar a) =>+    Baz a+class+    ( Foo a -- Foo?+    , Bar a -- Bar?+    , Baz a -- Baz+    ) =>+    BarBar a
+ data/examples/declaration/class/type-operators1-four-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++class (:$) a b++class+    (:&)+        a+        b++class a :* b++class+    a -- Before operator+        :+ b -- After operator++class+    ( f+        :. g+    )+        a
+ data/examples/declaration/class/type-operators2-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeOperators #-}++class a `Pair` b++class+    a+        `Sum` b++class (f `Product` g) a++class+    ( f+        `Sum` g+    )+        a
+ data/examples/declaration/class/type-operators3-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoStarIsType #-}++class PNum x where+    type (a :: x) * (b :: x)++instance PNum Nat where+    type a * b = ()
+ data/examples/declaration/data/deriving-four-out.hs view
@@ -0,0 +1,2 @@+newtype R r a = R (ReaderT r IO a)+    deriving (MonadReader r)
+ data/examples/declaration/data/deriving-strategies-four-out.hs view
@@ -0,0 +1,14 @@+module Main where++-- | Something.+newtype Foo = Foo Int+    deriving stock (Eq, Show, Generic)+    deriving anyclass+        ( ToJSON+        , FromJSON+        )+    deriving newtype (Num)+    deriving (Monoid) via (Sum Int)+    deriving+        (Semigroup)+        via (Sum Int)
+ data/examples/declaration/data/empty-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE EmptyDataDecls #-}++data Foo
+ data/examples/declaration/data/existential-four-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo = forall a. MkFoo a (a -> Bool)++data Bar = forall a b. a + b => Bar a b
+ data/examples/declaration/data/existential-multiline-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo+    = forall a. MkFoo a (a -> Bool)+    | forall a. Eq a => MkBar a++data Bar+    = forall x y.+        Bar x y x y++data Baz+    = forall x y.+        Baz+        x+        y+        x+        y
+ data/examples/declaration/data/fat-multiline-four-out.hs view
@@ -0,0 +1,12 @@+module Main where++-- | Something.+data Foo+    = -- | Foo+      Foo+        Int+        Int+    | -- | Bar+      Bar+        Bool+        Bool
+ data/examples/declaration/data/gadt-syntax-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE GADTSyntax #-}++data Foo where MKFoo :: a -> (a -> Bool) -> Foo
+ data/examples/declaration/data/gadt/multiline-four-out.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE ExplicitForAll #-}++module Main where++-- | Here goes a comment.+data Foo a where+    -- | 'Foo' is wonderful.+    Foo ::+        forall a b.+        (Show a, Eq b) => -- foo+        -- bar+        a ->+        b ->+        Foo 'Int+    -- | But 'Bar' is also not too bad.+    Bar ::+        Int ->+        Maybe Text ->+        Foo 'Bool+    -- | So is 'Baz'.+    Baz ::+        forall a.+        a ->+        Foo 'String+    (:~>) :: Foo a -> Foo a -> Foo a
+ data/examples/declaration/data/gadt/multiline-where-four-out.hs view
@@ -0,0 +1,7 @@+data+    Foo+        a+        b+        c+    where+    Foo :: a -> b -> c -> Foo a b c
+ data/examples/declaration/data/gadt/multiple-declaration-four-out.hs view
@@ -0,0 +1,15 @@+data GADT0 a where+    GADT01, GADT02 :: Int -> GADT0 a++data GADT1 a where+    GADT11+        , GADT12 ::+        Int ->+        GADT1 a++data GADT2 a where+    GADT21+        , GADT21+        , GADT22 ::+        Int ->+        GADT2 a
+ data/examples/declaration/data/gadt/record-four-out.hs view
@@ -0,0 +1,14 @@+module Main where++-- | Something.+data Foo where+    Foo :: {fooX :: Int} -> Foo+    Bar ::+        { fooY :: Int+        , fooBar, fooBaz :: Bool+        , fooFoo+          , barBar+          , bazBaz ::+            Int+        } ->+        Foo
+ data/examples/declaration/data/gadt/simple-four-out.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE ExplicitForAll #-}++module Main where++-- | Here goes a comment.+data Foo a where+    -- | 'Foo' is wonderful.+    Foo :: forall a b. (Show a, Eq b) => a -> b -> Foo 'Int+    Bar ::+        Int ->+        Text ->+        -- | But 'Bar' is also not too bad.+        Foo 'Bool+    Baz ::+        forall a.+        a ->+        -- | So is 'Baz'.+        Foo 'String
+ data/examples/declaration/data/gadt/strictness-four-out.hs view
@@ -0,0 +1,3 @@+data Foo a where+    Foo1 :: !Int -> {-# UNPACK #-} !Bool -> Foo Int+    Foo2 :: {-# UNPACK #-} Maybe Int && Bool -> Foo Int
+ data/examples/declaration/data/infix-four-out.hs view
@@ -0,0 +1,1 @@+data Foo a b = a `Foo` b
+ data/examples/declaration/data/kind-annotations-four-out.hs view
@@ -0,0 +1,10 @@+data Something (n :: Nat) = Something++data Format (k :: *) (k' :: *) (k'' :: *)++type Parens1 = Proxy '(a :: A, b :: (B :: *))+type Parens2 = Proxy '((a :: A), (b :: B))++type family Foo a where+    Foo '(a :: Int, b :: Bool) = Int+    Foo '((a :: Int), (b :: Bool)) = Int
+ data/examples/declaration/data/multiline-arg-parens-four-out.hs view
@@ -0,0 +1,10 @@+module Main where++-- | Something.+data Foo+    = Foo+        Bar+        (Set Baz) -- and here we go+        -- and that's it+        Text+    deriving (Eq)
+ data/examples/declaration/data/multiline-four-out.hs view
@@ -0,0 +1,12 @@+module Main where++-- | Here we have 'Foo'.+data Foo+    = -- | One+      Foo+    | -- | Two+      Bar Int+    | -- | Three+      Baz+    deriving+        (Eq, Show)
+ data/examples/declaration/data/multiline-names-four-out.hs view
@@ -0,0 +1,29 @@+data+    Foo+        a+        b+    = Foo a b++data a :-> b = Arrow (a -> b)++data (f :* g) a = f a :* g a++data+    ( f+        :+ g+    )+        a+    = L (f a)+    | R (g a)++data a `Arrow` b = Arrow' (a -> b)++data (f `Product` g) a = f a `Product` g a++data+    ( f+        `Sum` g+    )+        a+    = L' (f a)+    | R' (g a)
+ data/examples/declaration/data/newtype-four-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Something.+newtype Foo = Foo Int+    deriving (Eq, Show)
+ data/examples/declaration/data/operators-four-out.hs view
@@ -0,0 +1,12 @@+data ErrorMessage' s+    = -- | Show the text as is.+      Text s+    | -- | Pretty print the type.+      -- @ShowType :: k -> ErrorMessage@+      forall t. ShowType t+    | -- | Put two pieces of error message next+      -- to each other.+      ErrorMessage' s :<>: ErrorMessage' s+    | -- | Stack two pieces of error message on top+      -- of each other.+      ErrorMessage' s :$$: ErrorMessage' s
+ data/examples/declaration/data/partly-documented-four-out.hs view
@@ -0,0 +1,5 @@+data Optimisation+    = PETransform+    | -- | partial eval and associated transforms+      GeneralisedNatHack+    deriving (Show, Eq, Generic)
+ data/examples/declaration/data/record-four-out.hs view
@@ -0,0 +1,23 @@+module Main where++-- | Something.+data Foo = Foo+    { -- | X+      fooX :: Int+    , -- | Y+      fooY :: Int+    , -- | BarBaz+      fooBar, fooBaz :: NonEmpty (Identity Bool)+    , -- | GagGog+      fooGag+      , fooGog ::+        NonEmpty+            ( Indentity+                Bool+            )+    , -- | Huh!+      fooFoo+      , barBar ::+        Int+    }+    deriving (Eq, Show)
+ data/examples/declaration/data/record-multi-const-four-out.hs view
@@ -0,0 +1,17 @@+module Main where++-- | Something.+data Foo+    = Foo+        { -- | X+          fooX :: Int+        , -- | Y+          fooY :: Int+        }+    | Bar+        { -- | X+          barX :: Int+        , -- | Y+          barY :: Int+        }+    deriving (Eq, Show)
+ data/examples/declaration/data/record-singleline-four-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Something.+data Foo = Foo {fooX :: Int, fooY :: Int}+    deriving (Eq, Show)
+ data/examples/declaration/data/simple-broken-four-out.hs view
@@ -0,0 +1,9 @@+module Main where++-- | Here we go.+data Foo = Foo {unFoo :: Int}+    deriving (Eq)++-- | And once again.+data Bar = Bar {unBar :: Int}+    deriving (Eq)
+ data/examples/declaration/data/simple-four-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | And here we have 'Foo'.+data Foo = Foo | Bar Int | Baz+    deriving (Eq, Show)
+ data/examples/declaration/data/strictness-four-out.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Something.+data Foo+    = Foo1 !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String+    | Foo2 {a :: {-# UNPACK #-} Maybe Int && Bool}
+ data/examples/declaration/data/unnamed-field-comment-0-four-out.hs view
@@ -0,0 +1,7 @@+data Foo+    = -- | Bar+      Bar+        Field1+        -- ^ Field 1+        Field2+        -- ^ Field 2
+ data/examples/declaration/data/unnamed-field-comment-1-four-out.hs view
@@ -0,0 +1,5 @@+data X+    = B+        !Int+        -- ^ y+        C
+ data/examples/declaration/data/with-comment-four-out.hs view
@@ -0,0 +1,4 @@+data A+    = B -- C+    | -- D+      E
+ data/examples/declaration/data/with-weird-haddock-four-out.hs view
@@ -0,0 +1,4 @@+data PlusLevel' t+    = -- | @n + ℓ@.+      Plus Integer (LevelAtom' t)+    deriving (Show, Data)
+ data/examples/declaration/default/default-four-out.hs view
@@ -0,0 +1,7 @@+default (Int, Foo, Bar)++default+    ( Int+    , Foo+    , Bar+    )
+ data/examples/declaration/deriving/multiline-four-out.hs view
@@ -0,0 +1,22 @@+deriving instance+    Eq+        Foo++deriving stock instance+    Show+        Foo+deriving anyclass instance+    ToJSON+        Foo+deriving newtype instance+    Data+        Foo++deriving via+    Foo+        Int+    instance+        Triple+            A+            B+            C
+ data/examples/declaration/deriving/overlapping-four-out.hs view
@@ -0,0 +1,16 @@+deriving instance+    {-# OVERLAPPABLE #-}+    Ord+        Foo+deriving instance+    {-# OVERLAPPING #-}+    Num+        Foo+deriving instance+    {-# OVERLAPS #-}+    Read+        Foo+deriving instance+    {-# INCOHERENT #-}+    Show+        Foo
+ data/examples/declaration/deriving/singleline-four-out.hs view
@@ -0,0 +1,12 @@+deriving instance Eq Foo++deriving stock instance Show Foo+deriving anyclass instance ToJSON Foo+deriving newtype instance Data Foo++deriving instance {-# OVERLAPPABLE #-} Ord Foo+deriving instance {-# OVERLAPPING #-} Num Foo+deriving instance {-# OVERLAPS #-} Read Foo+deriving instance {-# INCOHERENT #-} Show Foo++deriving via Int instance Triple A B C
+ data/examples/declaration/foreign/foreign-export-four-out.hs view
@@ -0,0 +1,9 @@+foreign export ccall foo :: Int -> IO Int++-- | 'foreignTomFun' is a very important thing+foreign export ccall "tomography"+    foreignTomFun ::+        StablePtr Storage {- Storage is bad -} -> TomForegin++foreign export {- We can't use capi here -} ccall "dynamic"+    export_nullaryMeth :: (IO HRESULT) -> IO (Ptr ())
+ data/examples/declaration/foreign/foreign-import-four-out.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE CApiFFI #-}++foreign import ccall safe foo :: Int -> IO Int++-- | 'bar' is a very important thing+foreign import stdcall "baz" bar :: String -> Int -> IO String++foreign import stdcall unsafe "boo"+    -- Here is a comment about my foreign function+    boo :: Int -> Text -> IO Array++foreign import javascript+    baz ::+        String ->+        Int ->+        IO Foo++foreign import {- We use capi here -} capi "pi.h value pi" c_pi :: CDouble++foreign import stdcall {- This is a bad place for a comment -} "dynamic"+    dyn_gluBeginSurface ::+        -- | This 'FunPtr' is extremely dangerous, beware+        FunPtr (Ptr GLUnurbs -> IO ()) ->+        Ptr GLUnurbs ->+        IO ()
+ data/examples/declaration/instance/associated-data-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TypeFamilies #-}++instance Foo Int where data Bar Int = IntBar Int Int++instance Foo Double where+    newtype+        Bar+            Double+        = DoubleBar+            Double+            Double++instance Foo [a] where+    data Bar [a]+        = ListBar [Bar a]+    data Baz [a]+        = ListBaz
+ data/examples/declaration/instance/associated-types-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TypeFamilies #-}++instance Foo Int where type Bar Int = Double++instance Foo Double where+    type+        Bar+            Double =+            [Double]++    type+        Baz Double =+            [Double]
+ data/examples/declaration/instance/contexts-comments-four-out.hs view
@@ -0,0 +1,17 @@+instance+    ( Read a -- Foo+    , Read b+    , Read+        ( c -- Bar+        , d+        )+    ) =>+    Read+        ( a -- Baz+        , b+        , ( c -- Quux+          , d+          )+        )+    where+    readsPrec = undefined
+ data/examples/declaration/instance/contexts-four-out.hs view
@@ -0,0 +1,18 @@+instance Eq a => Eq [a] where (==) _ _ = False++instance+    ( Ord a+    , Ord b+    ) =>+    Ord (a, b)+    where+    compare _ _ = GT++instance+    (Show a, Show b) =>+    Show+        ( a+        , b+        )+    where+    showsPrec _ _ = showString ""
+ data/examples/declaration/instance/data-family-instances-four-out.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE TypeFamilies #-}++data instance Foo Int = FooInt Int++data instance+    Foo+        [Int]+    = IntListFoo+        ( Int+        , Int+        )+        ( Double+        , Double+        )++data instance Bar Double a+    = DoubleBar+        Double+        (Bar a)
+ data/examples/declaration/instance/data-family-instances-gadt-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE TypeFamilies #-}++data instance Bar Int a where+    SameBar ::+        Bar+            Int+            Int+    CloseBar :: Bar Int Double+    OtherBar ::+        Bar+            Int+            a
+ data/examples/declaration/instance/data-family-instances-newtype-four-out.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE TypeFamilies #-}++newtype instance Foo [Double] = DoubleListFoo+    { unDoubleListFoo :: Double+    }
+ data/examples/declaration/instance/empty-instance-four-out.hs view
@@ -0,0 +1,2 @@+instance Typeable Int+instance Generic Int
+ data/examples/declaration/instance/instance-sigs-four-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE InstanceSigs #-}++instance Eq Int where+    (==) :: Int -> Int -> Bool+    (==) _ _ = False++instance Ord Int where+    compare ::+        Int ->+        Int ->+        Ordering+    compare+        _+        _ =+            GT
+ data/examples/declaration/instance/instance-sigs-multiple-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE InstanceSigs #-}++instance Applicative [] where+    pure ::+        a ->+        [a]+    pure a = [a]+    (<*>) ::+        [a] -> [a] -> [a]+    (<*>) _ _ = []
+ data/examples/declaration/instance/multi-parameter-four-out.hs view
@@ -0,0 +1,5 @@+instance MonadReader a ((->) a) where ask = id++instance MonadState s (State s) where+    get = State.get+    put = State.put
+ data/examples/declaration/instance/newlines-after-where-four-out.hs view
@@ -0,0 +1,5 @@+instance Num X where+    (+) = undefined++instance Num Y where+    (+) = undefined
+ data/examples/declaration/instance/newlines-between-methods-four-out.hs view
@@ -0,0 +1,18 @@+instance Num a => Num (Diff a) where+    D u dudx + D v dvdx = D (u + v) (dudx + dvdx)+    D u dudx - D v dvdx = D (u - v) (dudx - dvdx)+    D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)++    -- Comment before definition+    negate (D u dudx) = D (- u) (- dudx)+    negate (Z u dudx) = undefined++    -- Comment after definition++    -- Separator++    abs (D u _) = D (abs u) (signum u)+    signum (D u _) = D (signum u) 0++    -- Comment between unrelated definitions+    fromInteger n = D (fromInteger n) 0
+ data/examples/declaration/instance/overlappable-instances-four-out.hs view
@@ -0,0 +1,14 @@+instance {-# OVERLAPPABLE #-} Eq Int where (==) _ _ = False++instance {-# OVERLAPPING #-} Ord Int where+    compare _ _ = GT++instance {-# OVERLAPS #-} Eq Double where+    (==) _ _ = False++instance+    {-# INCOHERENT #-}+    Ord+        Double+    where+    compare _ _ = GT
+ data/examples/declaration/instance/single-parameter-four-out.hs view
@@ -0,0 +1,9 @@+instance Monoid Int where (<>) x y = x + y++instance Enum Int where+    fromEnum x = x+    toEnum =+        \x ->+            x++instance Foo Int where foo x = x; bar y = y
+ data/examples/declaration/instance/type-family-instances-four-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE TypeFamilies #-}++type instance Foo Int = Int++type instance+    Foo+        [Int] =+        ( Int+        , Int+        )++type instance Bar Int [Int] Double = (Int, Double)++type instance+    Bar+        [Int]+        [Int]+        Double =+        ( Int+        , Double+        )
+ data/examples/declaration/rewrite-rule/basic1-four-out.hs view
@@ -0,0 +1,19 @@+{-# RULES+"fold/build" foldr k z (build g) = g k z+    #-}++{-# RULES+"fusable/aux"+    fusable x (aux y) =+        faux x y+    #-}++{-# RULES+"map/map"+    map+        f+        (map g xs) =+        map+            (f . g)+            xs+    #-}
+ data/examples/declaration/rewrite-rule/basic2-four-out.hs view
@@ -0,0 +1,16 @@+{-# RULES+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys+    #-}++{-# RULES+"++" xs ++ ys = augment (\c n -> foldr c n xs) ys+"concat" xs `concat` ys = augment (\c n -> foldr c n xs) ys+"map/Double" fmap f xs = foldr (++) f xs+    #-}++{-# RULES+"fb' >\\ (Request b' fb )" forall fb' b' fb.+    fb' >\\ (Request b' fb) =+        fb' b' >>= \b -> fb' >\\ fb b+    #-}
+ data/examples/declaration/rewrite-rule/empty-four-out.hs view
@@ -0,0 +1,3 @@+{-# RULES++    #-}
+ data/examples/declaration/rewrite-rule/forall-0-four-out.hs view
@@ -0,0 +1,9 @@+{-# RULES+"fold/build" forall k z. foldr k z (build g) = g k z+    #-}++{-# RULES+"fusable/aux" forall x y.+    fusable x (aux y) =+        faux x y+    #-}
+ data/examples/declaration/rewrite-rule/forall-1-four-out.hs view
@@ -0,0 +1,23 @@+{-# RULES "rd_tyvs" forall a. forall (x :: a). id x = x #-}++{-# RULES "rd_tyvs'" forall f a. forall (x :: f a). id x = x #-}++{-# RULES "rd_tyvs''" forall (a :: *). forall (x :: a). id x = x #-}++{-# RULES+"rd_tyvs_multiline1" forall (a :: *). forall (x :: a).+    id x =+        x+    #-}++{-# RULES+"rd_tyvs_multiline2" forall+    ( a ::+        *+    ). forall+    ( x ::+        a+    ).+    id x =+        x+    #-}
+ data/examples/declaration/rewrite-rule/phase-four-out.hs view
@@ -0,0 +1,23 @@+{-# RULES+"map/map" [2]+    map+        f+        (map g xs) =+        map+            (f . g)+            xs+    #-}++{-# RULES+"map/map" [1] forall x y z.+    map+        f+        (map g xs) =+        map+            (f . g)+            xs+    #-}++{-# RULES+"++" [~1] forall xs ys. xs ++ ys = augment (\c n -> foldr c n xs) ys+    #-}
+ data/examples/declaration/rewrite-rule/prelude1-four-out.hs view
@@ -0,0 +1,18 @@+{-# RULES+"map/map" forall f g xs. map f (map g xs) = map (f . g) xs+"map/append" forall f xs ys. map f (xs ++ ys) = map f xs ++ map f ys+    #-}++{-# RULES+"map" [~1] forall f xs. map f xs = build (\c n -> foldr (mapFB c f) n xs)+"mapList" [1] forall f. foldr (mapFB (:) f) [] = map f+"mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)+    #-}++{-# RULES+"map/map" [~2] forall f g xs.+    map f (map g xs) =+        map (f . g) xs+"f" op True y = False+"g" op True y = False+    #-}
+ data/examples/declaration/rewrite-rule/prelude2-four-out.hs view
@@ -0,0 +1,31 @@+{-# RULES+"fold/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b).+    foldr k z (build g) =+        g k z+"foldr/augment" forall k z xs (g :: forall b. (a -> b -> b) -> b -> b).+    foldr k z (augment g xs) =+        g k (foldr k z xs)+"foldr/id" foldr (:) [] = \x -> x+"foldr/app" [1] forall ys. foldr (:) ys = \xs -> xs ++ ys+-- Only activate this from phase 1, because that's+-- when we disable the rule that expands (++) into foldr++-- The foldr/cons rule looks nice, but it can give disastrously+-- bloated code when commpiling+--      array (a,b) [(1,2), (2,2), (3,2), ...very long list... ]+-- i.e. when there are very very long literal lists+-- So I've disabled it for now. We could have special cases+-- for short lists, I suppose.+-- "foldr/cons" forall k z x xs. foldr k z (x:xs) = k x (foldr k z xs)++"foldr/single" forall k z x. foldr k z [x] = k x z+"foldr/nil" forall k z. foldr k z [] = z+"augment/build" forall+    (g :: forall b. (a -> b -> b) -> b -> b)+    (h :: forall b. (a -> b -> b) -> b -> b).+    augment g (build h) =+        build (\c n -> g c (h c n))+"augment/nil" forall (g :: forall b. (a -> b -> b) -> b -> b).+    augment g [] =+        build g+    #-}
+ data/examples/declaration/rewrite-rule/prelude3-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}++{-# RULES+"x# `eqChar#` x#" forall x#. x# `eqChar#` x# = True+"x# `neChar#` x#" forall x#. x# `neChar#` x# = False+"x# `gtChar#` x#" forall x#. x# `gtChar#` x# = False+"x# `geChar#` x#" forall x#. x# `geChar#` x# = True+"x# `leChar#` x#" forall x#. x# `leChar#` x# = True+"x# `ltChar#` x#" forall x#. x# `ltChar#` x# = False+    #-}
+ data/examples/declaration/rewrite-rule/prelude4-four-out.hs view
@@ -0,0 +1,7 @@+{-# RULES+"unpack" [~1] forall a. unpackCString # a = build (unpackFoldrCString # a)+"unpack-list" [1] forall a. unpackFoldrCString # a (:) [] = unpackCString # a+"unpack-append" forall a n. unpackFoldrCString # a (:) n = unpackAppendCString # a n+-- There's a built-in rule (in PrelRules.lhs) for+--      unpackFoldr "foo" c (unpackFoldr "baz" c n)  =  unpackFoldr "foobaz" c n+    #-}
+ data/examples/declaration/rewrite-rule/type-signature-four-out.hs view
@@ -0,0 +1,17 @@+{-# RULES+"fold/build" forall k z (g :: forall b. (a -> b -> b) -> b -> b). foldr k z (build g) = g k z+    #-}++{-# RULES+"fold/build" forall+    k+    z+    ( g ::+        forall b.+        (a -> b -> b) ->+        b ->+        b+    ).+    foldr k z (build g) =+        g k z+    #-}
+ data/examples/declaration/role-annotation/multi-line-four-out.hs view
@@ -0,0 +1,15 @@+type role+    D+        phantom+        nominal++type role+    E+        _+        nominal++type role+    E+        _+        nominal+        phantom
+ data/examples/declaration/role-annotation/single-line-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RoleAnnotations #-}++type role Ptr representational++type role A nominal nominal++type role B _ phantom+type role C _ _
+ data/examples/declaration/signature/complete/complete-four-out.hs view
@@ -0,0 +1,10 @@+{-# COMPLETE A, B, C :: Foo #-}++{-# COMPLETE A, B #-}++{-# COMPLETE+    A+    , B+    , C ::+        Foo+    #-}
+ data/examples/declaration/signature/fixity/infix-four-out.hs view
@@ -0,0 +1,2 @@+infix 0 <?>+infix 9 <^-^>
+ data/examples/declaration/signature/fixity/infixl-four-out.hs view
@@ -0,0 +1,2 @@+infixl 8 ***+infixl 0 $, *, +, &&, **
+ data/examples/declaration/signature/fixity/infixr-four-out.hs view
@@ -0,0 +1,2 @@+infixr 8 `Foo`+infixr 0 ***, &&&
+ data/examples/declaration/signature/inline/conlike-four-out.hs view
@@ -0,0 +1,7 @@+foo :: Int+foo = 5+{-# INLINE CONLIKE foo #-}++bar :: Int+bar = 6+{-# INLINE CONLIKE bar #-}
+ data/examples/declaration/signature/inline/inline-four-out.hs view
@@ -0,0 +1,15 @@+foo :: Int -> Int+foo = id+{-# INLINE foo #-}++{-# INLINE [2] bar #-}+bar :: Int -> Int+bar = id++baz :: Int -> Int+baz = id+{-# INLINE [~2] baz #-}++reVector :: Bundle u a -> Bundle v a+{-# INLINE reVector #-}+reVector = M.reVector
+ data/examples/declaration/signature/inline/inlineable-four-out.hs view
@@ -0,0 +1,11 @@+foo :: Int -> Int+foo = id+{-# INLINEABLE foo #-}++{-# INLINEABLE [2] bar #-}+bar :: Int -> Int+bar = id++baz :: Int -> Int+baz = id+{-# INLINEABLE [~2] baz #-}
+ data/examples/declaration/signature/inline/noinline-four-out.hs view
@@ -0,0 +1,11 @@+foo :: Int -> Int+foo = id+{-# NOINLINE foo #-}++{-# NOINLINE [2] bar #-}+bar :: Int -> Int+bar = id++baz :: Int -> Int+baz = id+{-# NOINLINE [~2] baz #-}
+ data/examples/declaration/signature/minimal/minimal-four-out.hs view
@@ -0,0 +1,14 @@+class Foo a where+    {-# MINIMAL (==) | ((/=), foo) #-}++    {-# MINIMAL+        a+        | ( b, c, d+            | e+              , f+          )+          | g+        #-}++    (==) :: a -> a -> Bool+    (/=) :: a -> a -> Bool
+ data/examples/declaration/signature/pattern/multiline-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE PatternSynonyms #-}++pattern Arrow ::+    Type ->+    Type ->+    Type++pattern+    Foo+    , Bar ::+        Type -> Type -> Type++pattern+    TypeSignature+    , FunctionBody+    , PatternSignature+    , WarningPragma ::+        [RdrName] ->+        HsDecl GhcPs
+ data/examples/declaration/signature/pattern/single-line-four-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}++pattern Arrow :: Type -> Type -> Type++pattern Foo, Bar :: Type -> Type -> Type
+ data/examples/declaration/signature/set-cost-centre/set-cost-centre-four-out.hs view
@@ -0,0 +1,14 @@+f x y = g (x + y)+  where+    g z = z+    {-# SCC g #-}+{-# SCC f #-}++withString x y = x + y+{-# SCC withString "cost_centre_name" #-}++withString' x y = x + y+{-# SCC+    withString'+    "cost_centre_name"+    #-}
+ data/examples/declaration/signature/specialize/specialize-four-out.hs view
@@ -0,0 +1,24 @@+foo :: Num a => a -> a+foo = id+{-# SPECIALIZE foo :: Int -> Int #-}+{-# SPECIALIZE INLINE foo :: Float -> Float #-}++{-# SPECIALIZE NOINLINE [2] bar :: Int -> Int #-}+bar :: Num a => a -> a+bar = id++baz :: Num a => a -> a+baz = id+{-# SPECIALIZE [~2] baz ::+    Int ->+    Int+    #-}++{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}+{-# SPECIALIZE fits13Bits ::+    Int ->+    Bool+    , Integer -> Bool+    #-}+fits13Bits :: Integral a => a -> Bool+fits13Bits x = x >= -4096 && x < 4096
+ data/examples/declaration/signature/specialize/specialize-instance-four-out.hs view
@@ -0,0 +1,13 @@+data Foo a = Foo a+data VT v m r = VT v m r++instance (Eq a) => Eq (Foo a) where+    {-# SPECIALIZE instance Eq (Foo [(Int, Bar)]) #-}+    (==) (Foo a) (Foo b) = (==) a b++instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where+    {-# SPECIALIZE instance+        ( Factored m Int => Num (VT U.Vector m Int)+        )+        #-}+    VT x + VT y = VT $ V.zipWith (+) x y
+ data/examples/declaration/signature/type/arguments-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE RankNTypes #-}++functionName ::+    (C1, C2, C3, C4, C5) =>+    a ->+    b ->+    ( forall a.+      (C6, C7) =>+      LongDataTypeName ->+      a ->+      AnotherLongDataTypeName ->+      b ->+      c+    ) ->+    (c -> d) ->+    (a, b, c, d)
+ data/examples/declaration/signature/type/context-multi-line-four-out.hs view
@@ -0,0 +1,10 @@+functionName ::+    ( C1+    , C2+    , C3+    ) =>+    a ->+    b ->+    c ->+    d ->+    (a, b, c, d)
+ data/examples/declaration/signature/type/context-single-line-four-out.hs view
@@ -0,0 +1,7 @@+functionName ::+    (C1, C2, C3) =>+    a ->+    b ->+    c ->+    d ->+    (a, b, c, d)
+ data/examples/declaration/signature/type/infix-promoted-type-constructor-four-out.hs view
@@ -0,0 +1,2 @@+fun1 :: Def ('[Ref s (Stored Uint32), IBool] 'T.:-> IBool)+fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool)
data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs view
@@ -1,3 +1,2 @@ fun1 :: Def ('[Ref s (Stored Uint32), IBool] 'T.:-> IBool)- fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool)
+ data/examples/declaration/signature/type/long-function-name-four-out.hs view
@@ -0,0 +1,6 @@+longFunctionName ::+    a ->+    b ->+    c ->+    d ->+    (a, b, c, d)
+ data/examples/declaration/signature/type/long-multiline-applications-four-out.hs view
@@ -0,0 +1,16 @@+functionName ::+    (C1, C2, C3, C4, C5) =>+    forall a b c.+    a ->+    b ->+    ( LongDataTypeName+        AnotherLongDataTypeName+        AnotherLongDataTypeName2+        AnotherLongDataTypeName3 ->+      a ->+      AnotherLongDataTypeName4 ->+      b ->+      c+    ) ->+    (c -> d) ->+    (a, b, c, d)
+ data/examples/declaration/signature/type/multi-value-four-out.hs view
@@ -0,0 +1,15 @@+foo, bar :: Int+foo = 1+bar = 2++a, b, c :: Int+a = 1+b = 2+c = 3++foo+    , bar+    , baz ::+        Int+bar = 2+baz = 3
+ data/examples/declaration/signature/type/unicode-four-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++foo :: forall a. Show a => a -> String+foo = const ()
+ data/examples/declaration/signature/type/unrelated-four-out.hs view
@@ -0,0 +1,4 @@+clientFunc1 :: SomeType1+clientFunc2 :: SomeType2+clientFunc3 :: SomeType3+clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz
+ data/examples/declaration/signature/type/unrelated-out.hs view
@@ -0,0 +1,4 @@+clientFunc1 :: SomeType1+clientFunc2 :: SomeType2+clientFunc3 :: SomeType3+clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz
+ data/examples/declaration/signature/type/unrelated.hs view
@@ -0,0 +1,4 @@+clientFunc1 :: SomeType1+clientFunc2 :: SomeType2+clientFunc3 :: SomeType3+clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz
+ data/examples/declaration/splice/bracket-declaration-four-out.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TemplateHaskell #-}++[d|data T a where Foo :: T ()|]++foo =+    [d|+        foo :: Int -> Char++        bar = 42+        |]++[d|+    data T = T+        deriving (Eq, Ord, Enum, Bounded, Show)+    |]++$(do [d|baz = baz|])++$(singletons [d|data T = T deriving (Eq, Ord, Enum, Bounded, Show)|])++$( singletons+    [d|+        data T = T+            deriving (Eq, Ord, Enum, Bounded, Show)+        |]+ )
data/examples/declaration/splice/bracket-declaration-out.hs view
@@ -19,8 +19,8 @@ $(singletons [d|data T = T deriving (Eq, Ord, Enum, Bounded, Show)|])  $( singletons-     [d|-       data T = T-         deriving (Eq, Ord, Enum, Bounded, Show)-       |]+    [d|+      data T = T+        deriving (Eq, Ord, Enum, Bounded, Show)+      |]  )
+ data/examples/declaration/splice/bracket-four-out.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++foo =+    [|+        foo bar+        |]++foo =+    [e|+        foo bar+        |]++foo = [t|Char|]++foo =+    [||+    foo bar+    ||]
+ data/examples/declaration/splice/grouped-splices-four-out.hs view
@@ -0,0 +1,3 @@+$(deriveJSON fieldLabelMod ''A)+$(deriveJSON fieldLabelMod ''B)+$(deriveJSON fieldLabelMod ''C)
+ data/examples/declaration/splice/quasiquote-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE QuasiQuotes #-}++x = [foo|    foo bar   |]++x =+    [e|    foo+ bar  {- -}+  |]++[d|    foo bar++|]
+ data/examples/declaration/splice/quotes-four-out.hs view
@@ -0,0 +1,17 @@+foo = ''R++bar = 'foo++bar' = 'foo_bar++baz = ''(:#)++baz' = ''(Foo.Bar.:#)++equals = ''(==)++unit = ''()++list = ''[]++quolified = ''Semigroup.Option
+ data/examples/declaration/splice/splice-decl-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TemplateHaskell #-}++$(foo bar)++$foo++$$(foo bar)++$$foo++foo bar++[|booya|]++-- TemplateHaskell allows Q () at the top level+do+    pure []
+ data/examples/declaration/splice/typed-splice-four-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}++x =+    $$( foo bar+      )++x = $$foo
+ data/examples/declaration/splice/untyped-splice-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}++x = $(foo bar)++x =+    $( foo+        bar+     )++x = $foo
data/examples/declaration/splice/untyped-splice-out.hs view
@@ -4,7 +4,7 @@  x =   $( foo-       bar+      bar    )  x = $foo
+ data/examples/declaration/type-families/closed-type-family/infix-four-out.hs view
@@ -0,0 +1,11 @@+type family (x :: N) + (y :: N) :: N where+    'Zero + y = y+    'Succ n + y = 'Succ (n + y)++type family (x :: N) `LEQ` (y :: N) :: Bool where+    'Zero `LEQ` y = 'True+    'Succ n `LEQ` 'Zero = 'False+    'Succ n `LEQ` 'Succ m = n `LEQ` m++type family ((x :: N) `Weird` (y :: N)) (z :: N) :: Bool where+    'Zero `Weird` 'Zero 'Zero = 'True
+ data/examples/declaration/type-families/closed-type-family/injective-four-out.hs view
@@ -0,0 +1,5 @@+type family Id a = result | result -> a where+    Id a = a++type family G (a :: k) b c = foo | foo -> k b where+    G a b c = (a, b)
+ data/examples/declaration/type-families/closed-type-family/multi-line-four-out.hs view
@@ -0,0 +1,25 @@+type family+    Id a =+        result | result -> a+    where+    Id a =+        a++type family+    G+        (a :: k)+        b+        c =+        foo | foo -> k b+    where+    G a b c =+        (a, b)++type family+    F a ::+        * -> *+    where+    F Int = Double+    F Bool =+        Char+    F a = String
+ data/examples/declaration/type-families/closed-type-family/no-annotation-four-out.hs view
@@ -0,0 +1,4 @@+type family F a where+    F Int = Double+    F Bool = Char+    F a = String
+ data/examples/declaration/type-families/closed-type-family/simple-four-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Documentation.+type family F a :: * -> * where+    F Int = Double+    F Bool = Char+    F a = String
+ data/examples/declaration/type-families/closed-type-family/with-equal-sign-four-out.hs view
@@ -0,0 +1,2 @@+type family TF a b = result where+    TF a b = Int
+ data/examples/declaration/type-families/closed-type-family/with-forall-four-out.hs view
@@ -0,0 +1,3 @@+type family G a b where+    forall x y. G [x] (Proxy y) = Double+    forall z. z `G` z = Bool
+ data/examples/declaration/type-families/data-family/no-annotation-four-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+data family Array e
+ data/examples/declaration/type-families/data-family/simple-four-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+data family GMap k :: Type -> Type
+ data/examples/declaration/type-families/type-family/injective-four-out.hs view
@@ -0,0 +1,2 @@+type family Id a = r | r -> a+type family F a b c = d | d -> a c b
+ data/examples/declaration/type-families/type-family/no-annotation-four-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+type family F a b :: Type -> Type
+ data/examples/declaration/type-families/type-family/operator-four-out.hs view
@@ -0,0 +1,2 @@+type family a ! b+type family a . b
+ data/examples/declaration/type-families/type-family/simple-four-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+type family Elem c :: Type
+ data/examples/declaration/type-synonyms/multi-line-four-out.hs view
@@ -0,0 +1,18 @@+type Foo a b c =+    Bar c a b++type Foo+    a+    b+    c =+    Bar c a b++type Foo =+    Bar+        Baz+        Quux++type API =+    "route1" :> ApiRoute1+        :<|> "route2" :> ApiRoute2 -- comment here+        :<|> OmitDocs :> "i" :> ASomething API
+ data/examples/declaration/type-synonyms/simple-four-out.hs view
@@ -0,0 +1,8 @@+module Main where++-- | Documentation.+type Foo a b c = Bar c a b++type a ~> b = TyFun a b -> Type++type (a :+: b) c d e = ()
+ data/examples/declaration/type-synonyms/with-weird-haddock-four-out.hs view
@@ -0,0 +1,3 @@+type Elims =+    -- | eliminations ordered left-to-right.+    [Elim]
+ data/examples/declaration/type/forall-four-out.hs view
@@ -0,0 +1,4 @@+type CoerceLocalSig m m' =+    forall r a.+    LocalSig m r a ->+    LocalSig m' r a
+ data/examples/declaration/type/lits-four-out.hs view
@@ -0,0 +1,6 @@+type A = "foo"++type B =+    "foo\+    \bar" ->+    ()
+ data/examples/declaration/type/misc-kind-signatures-four-out.hs view
@@ -0,0 +1,5 @@+instance DemoteNodeTypes ('[] :: [NodeType]) where+    demoteNodeTypes _ = []++b :: (Bool :: *)+b = True
+ data/examples/declaration/type/promotion-four-out.hs view
@@ -0,0 +1,16 @@+type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge]++type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)++data T = T' | T'T++type S0 = ' T'++type S1 = ' T'T++type S2 = Proxy ('[ '[], '[]])+type S4 = Proxy ('( 'Just, ' T'T))+type S5 = Proxy ('[ 'Just, 'TT'T])+type S6 = Proxy ('( '(), '()))+type S7 = Proxy ('( 'a, 'b))+type S8 = Proxy ('[Int, Bool])
data/examples/declaration/type/promotion-out.hs view
@@ -1,5 +1,7 @@ type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge] +type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)+ data T = T' | T'T  type S0 = ' T'
data/examples/declaration/type/promotion.hs view
@@ -1,5 +1,7 @@ type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge ] +type Query = Query '[] '[] DB '[ 'NotNull 'PGint4] (RowPG RawElementData)+ data T = T' | T'T  type S0 = ' T'@@ -12,4 +14,3 @@ type S6 = Proxy ( '( '(), '() )) type S7 = Proxy ( '( 'a, 'b )) type S8 = Proxy ( '[ Int, Bool ])-
+ data/examples/declaration/type/splice-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TemplateHaskell #-}++type Foo = $(bar [t|Int|])
+ data/examples/declaration/type/type-applications-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TypeApplications #-}++type P = K @Bool @(Bool :: *) 'True 'False
+ data/examples/declaration/type/visible-forall-four-out.hs view
@@ -0,0 +1,2 @@+-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst+data T :: forall k -> k -> Type
+ data/examples/declaration/value/function/application-0-four-out.hs view
@@ -0,0 +1,17 @@+foo =+    f1+        p1+        p2+        p3++foo' =+    f2+        p1+        p2+        p3++foo'' =+    f3+        p1+        p2+        p3
+ data/examples/declaration/value/function/application-1-four-out.hs view
@@ -0,0 +1,19 @@+main =+    do+        x+        y+    z++main =+    case foo of+        x -> a+    foo+    a+    b++main =+    do+        if x then y else z+    foo+    a+    b
+ data/examples/declaration/value/function/arg-breakpoints-four-out.hs view
@@ -0,0 +1,3 @@+foo+    bar =+        body
+ data/examples/declaration/value/function/arg-breakpoints-out.hs view
@@ -0,0 +1,3 @@+foo+  bar =+    body
+ data/examples/declaration/value/function/arg-breakpoints.hs view
@@ -0,0 +1,3 @@+foo+  bar =+    body
+ data/examples/declaration/value/function/arithmetic-sequences-four-out.hs view
@@ -0,0 +1,16 @@+foo = [0 ..]+foo' = [0 .. 5]+bar x =+    [ 0+    .. x+    ]+baz x =+    [ 1+    , 3+    .. x+    ]+barbaz x = [0, 1 ..]+arst = [0 :: Int ..]+brst = [0, 1 :: Int ..]+crst = [0 :: Int .. 10]+drst = [0, 1 :: Int .. 10]
+ data/examples/declaration/value/function/arrow/multiline-case-four-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE Arrows #-}++f = proc x -> do+    x <-+        case x of X -> x+            -<+                y+    a -< b
+ data/examples/declaration/value/function/arrow/proc-applications-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE Arrows #-}++foo x = proc a -> a -< x++bar f x =+    proc+        ( y+            , z+            , w+            )+    ->+        f -- The value+            -<+                ( x -- Foo+                , w -- Bar+                , z -- Baz+                )++baz x = proc a -> a -<< x
+ data/examples/declaration/value/function/arrow/proc-cases-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE Arrows #-}++foo f = proc a -> case a of Left b -> f -< b++bar f g h j =+    proc a -> case a of+        Left+            ( (a, b)+                , (c, d)+                ) -> f (a <> c) -< b <> d+        Right+            (Left a) ->+                h -< a+        Right+            (Right b) ->+                j -< b
+ data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE Arrows #-}++foo+    f+    g+    h+    ma =+        proc+            ( (a, b)+                , (c, d)+                , (e, f)+                )+        -> do+            -- Begin do+            (x, y) <- -- GHC parser fails if layed out over multiple lines+                f -- Call into f+                    ( a+                    , c -- Tuple together arguments+                    )+                    ( b+                    , d+                    )+                    -<+                        ( b + 1 -- Funnel into arrow+                        , d * b+                        )+            if x `mod` y == 0 -- Basic condition+                then case e of -- Only left case is relevant+                    Left+                        ( z+                            , w+                            ) -> \u -> -- Procs can have lambdas+                            let v =+                                    u -- Actually never used+                                        ^ 2+                             in ( returnA+                                    -<+                                        -- Just do the calculation+                                        (x + y * z)+                                )+                else do+                    let u = x -- Let bindings bind expressions, not commands+                    -- Could pattern match directly on x+                    i <- case u of+                        0 -> (g . h -< u)+                        n ->+                            ( ( h . g+                                    -<+                                        y -- First actual use of y+                              )+                            )+                    returnA -< ()+                    -- Sometimes execute effects+                    if i > 0+                        then ma -< ()+                        else returnA -< ()+                    returnA+                        -<+                            ( i+                                + x+                                * y -- Just do the calculation+                            )
+ data/examples/declaration/value/function/arrow/proc-do-simple1-four-out.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE Arrows #-}++bar f = proc a -> do+    b <- f -< a++barbar f g = proc a -> do+    b <- f -< a+    returnA -< b++barbaz f g = proc (a, b) -> do+    c <- f -< a+    d <- g -< b++bazbar f = proc a -> do+    a <-+        f+            -<+                a
+ data/examples/declaration/value/function/arrow/proc-do-simple2-four-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE Arrows #-}++foo f = proc a -> do+    f -< a++bazbaz f g h = proc (a, b, c) -> do+    x <-+        f b -< a+    y <-+        g b -< b+    z <-+        h+            x+            y+            -<+                ( a+                , b+                , c+                )+    returnA+        -<+            (x, y, z)
+ data/examples/declaration/value/function/arrow/proc-forms1-four-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE Arrows #-}++foo0 f g x y = proc _ -> (| f (g -< (x, y)) |)++foo1 f g h x =+    proc (y, z) ->+        (|+            test+                ( h f+                    . h g+                    -<+                        y x+                            . y z+                )+                ( h g+                    . h f+                    -<+                        y z+                            . y x+                )+        |)
+ data/examples/declaration/value/function/arrow/proc-forms2-four-out.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE Arrows #-}++bar0 f g h x =+    proc (y, z) ->+        (| test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x)) |)++bar1 f g x y = proc _ -> (f -< x) &&& (g -< y)++bar2 f g h x =+    proc (y, z) ->+        (h f . (h g) -< (y x) . y z) ||| ((h g) . h f -< y z . (y x))++bar3 f g h x =+    proc (y, z) ->+        ( (h f . h g)+            -<+                (y x) . y z+        ) |||+            ( (h g . h f)+                -<+                    y z . (y x)+            )
+ data/examples/declaration/value/function/arrow/proc-ifs-four-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE Arrows #-}++foo f = proc a -> if a then f -< 0 else f -< 1++bar f g = proc a ->+    if f a+        then+            f+                . g+                -<+                    a+        else+            g+                -<+                    b
+ data/examples/declaration/value/function/arrow/proc-lambdas-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE Arrows #-}++foo = proc a -> \f b -> a -< f b -- Foo++bar =+    proc x -> \f g h ->+        \() ->+            \(Left (x, y)) -> -- Tuple value+                f (g (h x)) -< y
+ data/examples/declaration/value/function/arrow/proc-lets-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE Arrows #-}++foo f = proc a -> let b = a in f -< b++bar f g = proc a ->+    let h =+            f+                . g a+        j =+            g+                . h+     in id -< (h, j)
+ data/examples/declaration/value/function/arrow/proc-parentheses-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE Arrows #-}++foo f = proc a -> (f -< a)++bar f g = proc a ->+    ( ( (f)+            ( g+            )+      )+        -<+            ( ( ( ( ( ( g+                            a+                      )+                    )+                  )+                )+              )+            )+    )
+ data/examples/declaration/value/function/arrow/recursive-procs-four-out.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE Arrows #-}++foo f g = proc (x, y) -> do+    rec a <- f y -< x+        b <-+            g x+                -<+                    y+    bar+        -<+            ( a+            , b+            )+    rec p <-+            f+                p+                -<+                    a+    rec q <-+            g+                q+                -<+                    b
+ data/examples/declaration/value/function/awkward-comment-0-four-out.hs view
@@ -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)
+ data/examples/declaration/value/function/awkward-comment-1-four-out.hs view
@@ -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')
+ data/examples/declaration/value/function/backticks-four-out.hs view
@@ -0,0 +1,1 @@+foo x y = x `bar` y
+ data/examples/declaration/value/function/backticks-lhs-four-out.hs view
@@ -0,0 +1,7 @@+x `op1` (Just 0) = True+op1 x (Just _) = False+op1 x Nothing = undefined++op2 1 y = False+x `op2` y =+    True
+ data/examples/declaration/value/function/blank-lines-let-four-out.hs view
@@ -0,0 +1,6 @@+foo =+    let x = 10++        y = 11+        z = 12+     in x + y + z
+ data/examples/declaration/value/function/blank-lines-let-out.hs view
@@ -0,0 +1,6 @@+foo =+  let x = 10++      y = 11+      z = 12+   in x + y + z
+ data/examples/declaration/value/function/blank-lines-let.hs view
@@ -0,0 +1,9 @@+foo =+  let++    x = 10++    y = 11+    z = 12++  in x + y + z
+ data/examples/declaration/value/function/blank-lines-where-four-out.hs view
@@ -0,0 +1,6 @@+foo = x + y + z+  where+    x = 10++    y = 11+    z = 12
+ data/examples/declaration/value/function/blank-lines-where-out.hs view
@@ -0,0 +1,6 @@+foo = x + y + z+  where+    x = 10++    y = 11+    z = 12
+ data/examples/declaration/value/function/blank-lines-where.hs view
@@ -0,0 +1,7 @@+foo = x + y + z+  where++    x = 10++    y = 11+    z = 12
+ data/examples/declaration/value/function/block-arguments-four-out.hs view
@@ -0,0 +1,34 @@+f1 = foo do bar++f2 = foo do+    bar++f3 = foo case True of+    True -> bar+    False -> baz++f4 = foo let a = 3 in b++f5 =+    foo+        let a = 3+            b = a+         in b++f6 =+    foo+        if bar+            then baz+            else not baz++f7 = foo \x -> y++f8 = foo \x ->+    y++f9 = foo do { bar } baz++f10 = foo+    do a+    do b+    do c
+ data/examples/declaration/value/function/builtin-syntax-four-out.hs view
@@ -0,0 +1,1 @@+x = return ()
+ data/examples/declaration/value/function/case-multi-line-four-out.hs view
@@ -0,0 +1,27 @@+foo :: Int -> Int+foo x = case x of+    5 -> 10+    _ -> 12++bar :: Int -> Int+bar x =+    case x of+        5 ->+            if x > 5+                then 10+                else 12+        _ -> 12++baz :: Int -> Int+baz x = case x of+    5 -> 10+    _ -> 12++quux :: Int -> Int+quux x = case x of+    x -> x++funnyComment =+    -- comment+    case () of+        () -> ()
+ data/examples/declaration/value/function/case-multi-line-guards-four-out.hs view
@@ -0,0 +1,16 @@+withGuards :: Int -> Int+withGuards x =+    case x of+        x+            | x > 10 ->+                foo+                    + bar+        x | x > 5 -> 10+        _ -> 20++case x of+    '-' | not isUrl -> case xs of+        _ -> emitc '-'+    '*' | not isUrl ->+        case xs of+            _ -> emitc '*'
+ data/examples/declaration/value/function/case-single-line-four-out.hs view
@@ -0,0 +1,6 @@+foo :: Int -> Int+foo x = case x of x -> x++foo :: IO ()+foo = case [1] of [_] -> "singleton"; _ -> "not singleton"+foo = case [1] of { [] -> foo; _ -> bar } `finally` baz
+ data/examples/declaration/value/function/complex-list-four-out.hs view
@@ -0,0 +1,15 @@+handleStuff =+    handle+        [ \ExceptionA ->+            something+        , \ExceptionB ->+            somethingElse+        ]++handleStuff =+    handle+        [ foo+            bar+        , baz+            qux+        ]
+ data/examples/declaration/value/function/comprehension/transform-multi-line1-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TransformListComp #-}++foo' xs ys =+    [ ( x+      , y+      )+    | x <- xs+    , y <- ys+    , then+        -- First comment+        reverse -- Second comment+    ]
+ data/examples/declaration/value/function/comprehension/transform-multi-line2-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TransformListComp #-}++bar' xs ys =+    [ ( x+      , y+      )+    | x <- xs+    , y <- ys+    , then+        -- First comment+        sortWith+      by+        ( x+            + y -- Second comment+        )+    ]
+ data/examples/declaration/value/function/comprehension/transform-multi-line3-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TransformListComp #-}++baz' xs ys =+    [ ( x+      , y+      )+    | x <- xs+    , y <- ys+    , then group using+        -- First comment+        permutations -- Second comment+    ]
+ data/examples/declaration/value/function/comprehension/transform-multi-line4-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE TransformListComp #-}++quux' xs ys =+    [ ( x+      , y+      )+    | x <- xs+    , y <- ys+    , then group by+        -- First comment+        ( x+            + y+        )+      using+        -- Second comment+        groupWith -- Third comment+    ]
+ data/examples/declaration/value/function/comprehension/transform-single-line-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TransformListComp #-}++foo xs ys = [(x, y) | x <- xs, y <- ys, then reverse]++bar xs ys = [(x, y) | x <- xs, y <- ys, then sortWith by (x + y)]++baz xs ys = [(x, y) | x <- xs, y <- ys, then group using permutations]++quux xs ys = [(x, y) | x <- xs, y <- ys, then group by (x + y) using groupWith]
+ data/examples/declaration/value/function/do-single-multi-four-out.hs view
@@ -0,0 +1,4 @@+foo = do+    ( bar+            baz+        )
+ data/examples/declaration/value/function/do-where-four-out.hs view
@@ -0,0 +1,5 @@+f :: Maybe Int+f = do+    return c+  where+    c = 0
+ data/examples/declaration/value/function/do/applications-and-parens-four-out.hs view
@@ -0,0 +1,9 @@+warningFor var place = do+    guard $ isVariableName var+    guard . not $ isInArray var place || isGuarded place+    ( if includeGlobals || isLocal var+            then warningForLocals+            else warningForGlobals+        )+        var+        place
+ data/examples/declaration/value/function/do/blocks-four-out.hs view
@@ -0,0 +1,16 @@+foo = do bar+foo = do bar; baz+foo = do+    bar+    baz+foo = do do { foo; bar }; baz++readInClause = do+    do+        lookAhead g_Do+        parseNote ErrorC 1063 "You need a line feed or semicolon before the 'do'."+        <|> do+            optional g_Semi+            void allspacing++    return things
+ data/examples/declaration/value/function/do/comment-alignment-four-out.hs view
@@ -0,0 +1,9 @@+main = do+    case blah of+        Nothing -> return ()+        Just xs -> do+            forM_ xs foo+            bar+    -- and here it goes+    unless bobla $+        quux
+ data/examples/declaration/value/function/do/comment-spacing-four-out.hs view
@@ -0,0 +1,7 @@+foo = do+    bar+    -- foo+    baz++    -- foo+    quux
+ data/examples/declaration/value/function/do/expr-four-out.hs view
@@ -0,0 +1,10 @@+quux = something $ do+    foo+    case x of+        1 -> 10+        2 -> 20+    bar+    if something+        then x+        else y+    baz
+ data/examples/declaration/value/function/do/hang-rhs-arrow-four-out.hs view
@@ -0,0 +1,9 @@+foo = do+    something <- case bar of+        Foo -> return 1+        Bar -> return 2+    somethingElse <-+        case boom of+            Foo -> return 1+            Bar -> return 2+    quux something somethingElse
+ data/examples/declaration/value/function/do/let-four-out.hs view
@@ -0,0 +1,18 @@+main = do+    a <- bar+    let a = b; c = d+    baz d+    let e = f+        g = h+    return c++-- single line let-where+samples n f = do+    gen <- newQCGen+    let rands g = g1 : rands g2 where (g1, g2) = split g+    return $ rands gen++trickyLet = do+    foo+    let x = 5+     in bar x
+ data/examples/declaration/value/function/do/operator-and-parens-four-out.hs view
@@ -0,0 +1,7 @@+scientifically :: (Scientific -> a) -> Parser a+scientifically h = do+    something+    ( I.satisfy (\w -> w == 'e' || w == 'E')+            *> fmap (h . Sci.scientific signedCoeff . (e +)) (signed decimal)+        )+        <|> return (h $ Sci.scientific signedCoeff e)
+ data/examples/declaration/value/function/do/recursive-do-mdo-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE RecursiveDo #-}++baz =+    mdo+        bar a+        a <- foo+        b <-+            bar+                1+                2+                3+        return (a + b)
+ data/examples/declaration/value/function/do/recursive-do-rec-four-out.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE RecursiveDo #-}++foo = do+    rec a <- b + 5++        let d = c++        b <- a * 5++        something++        c <- a + b+    print c+    rec something $ do+            x <- a+            print x++            y <- c+            print y
+ data/examples/declaration/value/function/equality-constraints-four-out.hs view
@@ -0,0 +1,2 @@+foo :: (a ~ b) => a -> b -> Int+foo = undefined
+ data/examples/declaration/value/function/explicit-type-four-out.hs view
@@ -0,0 +1,5 @@+foo = 5 :: Int++bar =+    5 ::+        Int
+ data/examples/declaration/value/function/fancy-forall-0-four-out.hs view
@@ -0,0 +1,10 @@+wrapError ::+    forall outertag innertag t outer inner m a.+    ( forall x. Coercible (t m x) (m x)+    , forall m'.+      HasCatch outertag outer m' =>+      HasCatch innertag inner (t m')+    , HasCatch outertag outer m+    ) =>+    (forall m'. HasCatch innertag inner m' => m' a) ->+    m a
+ data/examples/declaration/value/function/fancy-forall-1-four-out.hs view
@@ -0,0 +1,10 @@+magnify ::+    forall outertag innertag t outer inner m a.+    ( forall x. Coercible (t m x) (m x)+    , forall m'.+      HasReader outertag outer m' =>+      HasReader innertag inner (t m')+    , HasReader outertag outer m+    ) =>+    (forall m'. HasReader innertag inner m' => m' a) ->+    m a
+ data/examples/declaration/value/function/guards-four-out.hs view
@@ -0,0 +1,12 @@+baz :: Int -> Int+baz x | x < 0 = x+baz x | otherwise = x++multi_baz :: Int -> Int+multi_baz x | x < 42 = x+multi_baz x | x < 0 = x+multi_baz x | otherwise = x++quux :: Int -> Int+quux x | x < 0 = x+quux x = x
+ data/examples/declaration/value/function/if-multi-line-four-out.hs view
@@ -0,0 +1,23 @@+foo :: Int -> Int+foo x =+    if x > 5+        then 10+        else 12++bar :: Int -> Int+bar x =+    if x > 5+        then+            foo x+                + 100+        else case x of+            1 -> 10+            _ -> 20++baz :: Int -> Bar+baz x =+    if x > 5+        then \case+            Foo -> bar+        else do+            undefined
+ data/examples/declaration/value/function/if-single-line-four-out.hs view
@@ -0,0 +1,6 @@+foo :: Int -> Int+foo x = if x > 5 then 10 else 12++bar :: Int -> Int+bar x =+    if x > 5 then 10 else 12
+ data/examples/declaration/value/function/if-with-comment-four-out.hs view
@@ -0,0 +1,8 @@+foo =+    if undefined+        then -- then comment+            undefined+        else -- else comment++        do+            undefined
+ data/examples/declaration/value/function/implicit-params-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE ImplicitParams #-}++sortBy :: (a -> a -> Bool) -> [a] -> [a]+sortBy = undefined++sort :: (?cmp :: a -> a -> Bool) => [a] -> [a]+sort = sortBy ?cmp++sort' ::+    ( ?cmp ::+        a -> a -> Bool+    , ?foo :: Int+    ) =>+    [a] ->+    [a]+sort' = sort
data/examples/declaration/value/function/implicit-params-out.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE ImplicitParams #-}  sortBy :: (a -> a -> Bool) -> [a] -> [a]+sortBy = undefined  sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] sort = sortBy ?cmp
data/examples/declaration/value/function/implicit-params.hs view
@@ -1,6 +1,8 @@ {-# LANGUAGE ImplicitParams #-} sortBy :: (a -> a -> Bool) -> [a] -> [a] +sortBy = undefined+ sort   :: (?cmp :: a -> a -> Bool) => [a] -> [a] sort    = sortBy ?cmp
+ data/examples/declaration/value/function/infix/applicative-four-out.hs view
@@ -0,0 +1,4 @@+f =+    Foo <$> bar+        <*> baz+        <*> baz'
+ data/examples/declaration/value/function/infix/comments-four-out.hs view
@@ -0,0 +1,8 @@+main =+    bar $ -- bar+        baz -- baz++bar $+    {- foo+     -}+    bar
+ data/examples/declaration/value/function/infix/do-four-out.hs view
@@ -0,0 +1,13 @@+main =+    do stuff+    `finally` do+        recover++main = do stuff `finally` recover++main = do { stuff } `finally` recover++foo =+    do+        1+        + 2
+ data/examples/declaration/value/function/infix/dollar-chains-four-out.hs view
@@ -0,0 +1,22 @@+module Main where++foo =+    fmap escapeLeadingDollar+        . dropPaddingSpace+        . dropWhileEnd T.null+        . fmap (T.stripEnd . T.pack)+        . lines+        $ unpackHDS docStr++foo =+    when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $+        throwIO (OrmoluCppEnabled path)++foo =+    bar $+        baz $+            quux++x =+    case l of { A -> B } $+        case q of r -> s
data/examples/declaration/value/function/infix/dollar-chains-out.hs view
@@ -13,9 +13,9 @@     throwIO (OrmoluCppEnabled path)  foo =-  bar-    $ baz-    $ quux+  bar $+    baz $+      quux  x =   case l of { A -> B } $
+ data/examples/declaration/value/function/infix/hanging-four-out.hs view
@@ -0,0 +1,23 @@+f = unFoo . foo bar baz 3 $ do+    act+    ret++g = unFoo+    . foo+        bar+        baz+        3+    $ do+        act+        ret++update =+    do+        foobar+        `catch` \case+            a -> a++foo =+    bar+        ++ case foo of+            a -> a
data/examples/declaration/value/function/infix/hanging-out.hs view
@@ -17,6 +17,7 @@     `catch` \case       a -> a -foo = bar-  ++ case foo of-    a -> a+foo =+  bar+    ++ case foo of+      a -> a
+ data/examples/declaration/value/function/infix/lenses-four-out.hs view
@@ -0,0 +1,21 @@+lenses =+    Just $+        M.fromList $+            "type" .= ("user.connection" :: Text)+                # "connection" .= uc+                # "user" .= case name of+                    Just n -> Just $ object ["name" .= n]+                    Nothing -> Nothing+                # []++foo =+    a+        & b .~ 2+        & c .~ 3++wreq =+    let opts =+            defaults & auth ?~ awsAuth AWSv4 "key" "secret"+                & header "Accept" .~ ["application/json"]+                & header "Runscope-Bucket-Auth" .~ ["1example-1111-4yyyy-zzzz-xxxxxxxx"]+     in getWith opts
data/examples/declaration/value/function/infix/lenses-out.hs view
@@ -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
+ data/examples/declaration/value/function/infix/simple-four-out.hs view
@@ -0,0 +1,12 @@+(*) :: Int -> Int -> Int+x * y = z++foo :: Int -> Int -> Int+x `foo` y = z++bar :: Int -> Int -> Int -> Int+(x `bar` y) z = z++multiline :: Int -> Int -> Int+x+    `multiline` y = z
+ data/examples/declaration/value/function/infix/unicode-four-out.hs view
@@ -0,0 +1,3 @@+main = print ('a' → 'a')+  where+    (→) = (,)
+ data/examples/declaration/value/function/lambda-case-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE LambdaCase #-}++foo = bar (\case JKey{} -> True; _ -> False)++foo :: Int -> Int+foo = \case+    5 -> 10+    i | i > 5 -> 11+    _ -> 12
+ data/examples/declaration/value/function/lambda-multi-line1-four-out.hs view
@@ -0,0 +1,15 @@+foo :: a -> a -> a+foo x = \y ->+    x++bar :: Int -> Int -> Int+bar x = \y ->+    if x > y+        then 10+        else 12++foo =+    prop "is inverse to closure" $+        \(f :: StaticPtr (Int -> Int))+         (x :: Int) ->+                (unclosure . closure) f x == deRefStaticPtr f x
+ data/examples/declaration/value/function/lambda-multi-line2-four-out.hs view
@@ -0,0 +1,12 @@+tricky0 =+    flip all (zip ws gs) $ \(wt, gt) ->+        canUnify poly_given_ok wt gt || go False wt gt++tricky1 =+    flip all (zip ws gs) $+        \(wt, gt) -> canUnify poly_given_ok wt gt || go False wt gt++tricky2 =+    flip all (zip ws gs) $+        \(wt, gt) ->+            canUnify poly_given_ok wt gt || go False wt gt
+ data/examples/declaration/value/function/lambda-single-line-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE BangPatterns #-}++foo :: a -> a -> a+foo x = \y -> x++bar :: a -> a -> a+bar x =+    \y -> x++baz :: a -> a -> a+baz = \ ~x ~y -> x++zag :: a -> a -> a+zag = \ !x !y -> x++spl :: a -> a+spl = \ $([p|x|]) -> x
+ data/examples/declaration/value/function/let-multi-line-four-out.hs view
@@ -0,0 +1,28 @@+foo :: Int -> Int+foo x =+    let z = y+        y = x+     in z + 100++bar :: Int -> Int+bar x =+    let z = y+        y = x+     in z+            + 100++inlineComment :: Int -> Int+inlineComment =+    let {- join -} go = case () of+                    () -> undefined+     in go++implicitParams :: HasCallStack => Int+implicitParams =+    let ?cs = ?callstack+     in foo cs++sitting =+    foo $+        let x = 20+         in x
data/examples/declaration/value/function/let-multi-line-out.hs view
@@ -14,7 +14,7 @@ inlineComment :: Int -> Int inlineComment =   let {- join -} go = case () of-                   () -> undefined+                  () -> undefined    in go  implicitParams :: HasCallStack => Int
+ data/examples/declaration/value/function/let-nested-four-out.hs view
@@ -0,0 +1,3 @@+_ = _+  where+    _ = [_ | let _ = _]
+ data/examples/declaration/value/function/let-single-line-four-out.hs view
@@ -0,0 +1,8 @@+foo :: a -> a+foo x = let x = x in x+foo x = let x = z where z = 2 in x+foo x = let x = z where { z = 2 }; a = 3 in x+foo x = let g :: Int -> Int; g = id in ()+let a = b; c = do { foo; bar }; d = baz in b+let a = case True of { True -> foo; False -> bar }; b = foo a in b+foo x = let ?g = id; ?f = g in x
+ data/examples/declaration/value/function/list-comprehensions-four-out.hs view
@@ -0,0 +1,24 @@+foo x = [a | a <- x]++bar x y = [(a, b) | a <- x, even a, b <- y, a != b]++barbaz x y z w =+    [ (a, b, c, d) -- Foo+    | a <-+        x -- Bar+    , b <- y -- Baz+    , any even [a, b]+    , c <-+        z+            * z ^ 2 -- Bar baz+    , d <-+        w+            + w -- Baz bar+    , all+        even+        [ a+        , b+        , c+        , d+        ]+    ]
+ data/examples/declaration/value/function/list-notation-0-four-out.hs view
@@ -0,0 +1,5 @@+foo =+    testCase "Foo" testFoo :+    testCase "Bar" testBar :+    testCase "Baz" testBaz :+    []
+ data/examples/declaration/value/function/list-notation-0-out.hs view
@@ -0,0 +1,5 @@+foo =+  testCase "Foo" testFoo :+  testCase "Bar" testBar :+  testCase "Baz" testBaz :+  []
+ data/examples/declaration/value/function/list-notation-0.hs view
@@ -0,0 +1,5 @@+foo =+  testCase "Foo" testFoo :+  testCase "Bar" testBar :+  testCase "Baz" testBaz :+  []
+ data/examples/declaration/value/function/list-notation-1-four-out.hs view
@@ -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]
+ data/examples/declaration/value/function/list-notation-1-out.hs view
@@ -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]
+ data/examples/declaration/value/function/list-notation-1.hs view
@@ -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 ]
+ data/examples/declaration/value/function/list-notation-2-four-out.hs view
@@ -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
+ data/examples/declaration/value/function/list-notation-2-out.hs view
@@ -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
+ data/examples/declaration/value/function/list-notation-2.hs view
@@ -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
+ data/examples/declaration/value/function/list-notation-3-four-out.hs view
@@ -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
+ data/examples/declaration/value/function/list-notation-3-out.hs view
@@ -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
+ data/examples/declaration/value/function/list-notation-3.hs view
@@ -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
+ data/examples/declaration/value/function/multi-way-if-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE MultiWayIf #-}++foo x = if | x == 5 -> 5++bar x y =+    if+            | x > y -> x+            | x < y ->+                y+            | otherwise -> x++baz =+    if+            | p -> f+            | otherwise -> g+        x
+ data/examples/declaration/value/function/multiline-arguments-four-out.hs view
@@ -0,0 +1,8 @@+foo :: Int -> Int -> Int -> Int+foo+    (Foo g o)+    ( Bar+            x+            y+        )+    z = x
+ data/examples/declaration/value/function/multiple-guards-four-out.hs view
@@ -0,0 +1,14 @@+foo :: Int -> Int+foo x+    | x == 5 = 10+    | otherwise = 12++bar :: Int -> Int+bar x+    | x == 5 =+        foo x+            + foo 10+    | x == 6 =+        foo x+            + foo 20+    | otherwise = foo 100
+ data/examples/declaration/value/function/multiple-matches-four-out.hs view
@@ -0,0 +1,3 @@+foo :: Int -> Int+foo 5 = 10+foo _ = 12
+ data/examples/declaration/value/function/negation-four-out.hs view
@@ -0,0 +1,8 @@+foo :: Int+foo = (-2)++bar :: Int+bar = -2++baz :: Int+baz = - 2
+ data/examples/declaration/value/function/newline-single-line-body-four-out.hs view
@@ -0,0 +1,10 @@+function :: Int -> Int+function a =+    aReallyLongFunctionNameThatShouldStayOnThisLineToAvoidOverflowing 10000 a++function' :: String -> String+function' s = case s of+    "ThisString" ->+        -- And a comment here is okay+        "Yay"+    _ -> "Boo"
+ data/examples/declaration/value/function/operator-comments-0-four-out.hs view
@@ -0,0 +1,16 @@+foo =+    bar+        +++        {- some comment -}+        case foo of+            a -> a++foo =+    bar+        ++ {- some comment -} case foo of+            a -> a++foo =+    bar+        ++ case foo {- some comment -} of+            a -> a
+ data/examples/declaration/value/function/operator-comments-1-four-out.hs view
@@ -0,0 +1,16 @@+foo =+    bar+        +++        -- some comment+        case foo of+            a -> a++foo =+    bar+        ++ case foo of -- some comment+            a -> a++foo =+    bar+        ++ case foo of -- some comment+            a -> a
+ data/examples/declaration/value/function/operator-comments-2-four-out.hs view
@@ -0,0 +1,5 @@+x =+    y+        ++ f g -- commentA+        -- commentB+        -- commentC
+ data/examples/declaration/value/function/operator-sections-four-out.hs view
@@ -0,0 +1,11 @@+foo = (0 +)+bar = (<> "hello")+baz =+    ( 1 * 2+        ++    )+        ( *+            3 ^ 5+        )++quux = (,) <$> foo <$> bar
+ data/examples/declaration/value/function/operators-0-four-out.hs view
@@ -0,0 +1,5 @@+a =+    b & c .~ d+        & e+            %~ f+                g
+ data/examples/declaration/value/function/operators-1-four-out.hs view
@@ -0,0 +1,4 @@+foo =+    f+        . g+        =<< h . i
+ data/examples/declaration/value/function/operators-2-four-out.hs view
@@ -0,0 +1,4 @@+foo n+    | x || y && z || n ** x+        || x && n =+        42
+ data/examples/declaration/value/function/operators-3-four-out.hs view
@@ -0,0 +1,3 @@+foo =+    op <> n <+> colon <+> prettySe <+> text "="+        <+> prettySe <> text sc
+ data/examples/declaration/value/function/operators-4-four-out.hs view
@@ -0,0 +1,3 @@+foo =+    line <> bindingOf <+> text "=" <+> tPretty <+> colon+        <+> align <> prettyPs
+ data/examples/declaration/value/function/operators-5-four-out.hs view
@@ -0,0 +1,5 @@+foo =+    map bar $+        [ baz+        ]+            ++ quux
+ data/examples/declaration/value/function/operators-6-four-out.hs view
@@ -0,0 +1,9 @@+type PermuteRef =+    "a"+        :> ( "b" :> "c" :> End+                :<|> "c" :> "b" :> End+           )+        :<|> "b"+            :> ( "a" :> "c" :> End+                    :<|> "c" :> "a" :> End+               )
data/examples/declaration/value/function/operators-6-out.hs view
@@ -1,9 +1,9 @@ type PermuteRef =   "a"     :> ( "b" :> "c" :> End-           :<|> "c" :> "b" :> End+          :<|> "c" :> "b" :> End        )     :<|> "b"       :> ( "a" :> "c" :> End-             :<|> "c" :> "a" :> End+            :<|> "c" :> "a" :> End          )
+ data/examples/declaration/value/function/overindentation-four-out.hs view
@@ -0,0 +1,11 @@+reallyincrediblyLongName =+    f+        a+        A+            { reallyincrediblyLongName =+                f+                    a+                    A+                        { reallyincrediblyLongName+                        }+            }
+ data/examples/declaration/value/function/overloaded-labels-four-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE OverloadedLabels #-}++foo = #field+bar = (#this) (#that)
+ data/examples/declaration/value/function/parallel-comprehensions-complex-four-out.hs view
@@ -0,0 +1,35 @@+baz x y z w =+    [ ( a+      , b+      , c+      , d+      , e+      , f+      , g+      , h+      , i+      , j+      )+    | a <- -- Foo 1+        x -- Foo 2+    , b <- -- Bar 1+        y -- Bar 2+    , a+        `mod` b -- Value+        == 0+    | c <- -- Baz 1+        z+            * z -- Baz 2+            -- Baz 3+    | d <- w -- Other+    | e <- x * x -- Foo bar+    | f <- -- Foo baz 1+        y + y -- Foo baz 2+    | h <- z + z * w ^ 2 -- Bar foo+    | i <- -- Bar bar 1+        a+            + b -- Bar bar 2+            -- Bar bar 3+    , j <- -- Bar baz 1+        a + b -- Bar baz 2+    ]
+ data/examples/declaration/value/function/parallel-comprehensions-single-line-four-out.hs view
@@ -0,0 +1,3 @@+foo x y = [(a, b) | a <- x | b <- y]++bar x y z w = [(a, b, c, d) | a <- x, b <- y, a `mod` b == 0 | c <- z | d <- w]
+ data/examples/declaration/value/function/parens-four-out.hs view
@@ -0,0 +1,1 @@+f = p (do foo; bar) baz
+ data/examples/declaration/value/function/parenthesis-lhs-four-out.hs view
@@ -0,0 +1,9 @@+(!=!) 2 y = 1+x !=! y = 2++x ?=? [] = 123+(?=?) x (_ : []) = 456+x ?=? _ = f x x+  where+    f x 7 = 789+    x `f` _ = 101
+ data/examples/declaration/value/function/pattern/as-pattern-four-out.hs view
@@ -0,0 +1,3 @@+main = case [1] of+    xs@(x : _) -> print (x, xs)+    xs@[] -> print xs
+ data/examples/declaration/value/function/pattern/famous-cardano-pattern-four-out.hs view
@@ -0,0 +1,8 @@+( getNodeSettingsR+        :<|> getNodeInfoR+        :<|> getNextUpdateR+        :<|> restartNodeR+    )+    :<|> ( getUtxoR+                :<|> getConfirmedProposalsR+            ) = client nodeV1Api
data/examples/declaration/value/function/pattern/famous-cardano-pattern-out.hs view
@@ -4,5 +4,5 @@     :<|> restartNodeR   )   :<|> ( getUtxoR-           :<|> getConfirmedProposalsR-         ) = client nodeV1Api+          :<|> getConfirmedProposalsR+        ) = client nodeV1Api
+ data/examples/declaration/value/function/pattern/multiline-case-pattern-four-out.hs view
@@ -0,0 +1,15 @@+readerBench doc name =+    runPure $ case (getReader name, getWriter name) of+        ( Right (TextReader r, rexts)+            , Right (TextWriter w, wexts)+            ) -> undefined++f xs = case xs of+    [ a+        , b+        ] -> a + b++g xs = case xs of+    ( a+            : bs+        ) -> a + b
+ data/examples/declaration/value/function/pattern/n-plus-k-pattern-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NPlusKPatterns #-}++singleline :: Int+singleline (n + 1) = n++multiline :: Int+multiline+    ( n+            + 1+        ) = n++n :: Int+(n + 1) = 3
+ data/examples/declaration/value/function/pattern/pattern-bind-four-out.hs view
@@ -0,0 +1,9 @@+foo = bar+  where+    Foo bar baz = quux+    Baz+        quux = zoo++foo = bar+  where+    Foo bar baz = quux
+ data/examples/declaration/value/function/pattern/quasi-quotes-pattern-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE QuasiQuotes #-}++singleline :: ()+singleline [yamlQQ|something|] = ()++multiline :: ()+multiline = case y of+    [yamlQQ| name: John Doe+age: 23+|] -> ()
+ data/examples/declaration/value/function/pattern/record-patterns-four-out.hs view
@@ -0,0 +1,19 @@+foo :: Boom -> Int+foo Boom{..} = 10++bar0 :: Boom -> Int+bar0 Boom{boom} = boom++bar1 :: Boom -> Int+bar1 Boom{boom = b} = b++baz :: Boom -> Int+baz Boom{boom = b, ..} = b++quux :: Boom -> Int+quux+    Boom+        { boom = a+        , foom = b+        , ..+        } = a + b
+ data/examples/declaration/value/function/pattern/sig-pattern-four-out.hs view
@@ -0,0 +1,7 @@+f = do+    x :: a <- g++f = do+    (x, y) ::+        (a, b) <-+        g
+ data/examples/declaration/value/function/pattern/splice-pattern-four-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE TemplateHaskell #-}++singleLine = case () of+    $x -> ()+    $(y "something") -> ()++multiline = case () of+    $( x+        + y+     ) -> ()+    $( y+        "something"+     ) -> ()
data/examples/declaration/value/function/pattern/splice-pattern-out.hs view
@@ -6,8 +6,8 @@  multiline = case () of   $( x-       + y+      + y    ) -> ()   $( y-       "something"+      "something"    ) -> ()
+ data/examples/declaration/value/function/pattern/strictness-four-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE BangPatterns #-}++!a = ()+~b = ()
+ data/examples/declaration/value/function/pattern/unboxed-sum-pattern-four-out.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE UnboxedSums #-}++v = True+  where+    (# _x #) = (# True #)++p = True+  where+    (# _x | #) = (# | True #)++q = True+  where+    (# | _x | #) = (# | True | #)++z = True+  where+    (# | | _x #) = (# | | True #)++z_multiline = True+  where+    (#+        | | _x+        #) =+            (#+                | | True+            #)
+ data/examples/declaration/value/function/pattern/view-pattern-four-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE ViewPatterns #-}++example f (f -> 4) = True++f (t -> Nothing) = "Nothing"+f (t -> Just _) = "Just"++g ((f, _), f -> 4) = True++multiline+    ( t ->+            Foo+                bar+                baz+        ) = True
+ data/examples/declaration/value/function/pragmas-four-out.hs view
@@ -0,0 +1,9 @@+sccfoo = {-# SCC foo #-} 1+sccbar =+    {-# SCC "barbaz" #-}+    "hello"++corefoo = {-# CORE "foo" #-} 1+corebar =+    {-# CORE "bar baz" #-}+    "hello"
+ data/examples/declaration/value/function/prefix-four-out.hs view
@@ -0,0 +1,1 @@+foo x y = (+) x y
+ data/examples/declaration/value/function/quasi-quotes-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE QuasiQuotes #-}++singleline :: Value+singleline = [yamlQQ|something|]++multiline :: Value+multiline =+    [yamlQQ| name: John Doe+age: 23++something: foo+|]
+ data/examples/declaration/value/function/simple-four-out.hs view
@@ -0,0 +1,2 @@+bar x = x+baz = x
+ data/examples/declaration/value/function/splice-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}++bar = $bar++bar' = $(bar "something")++baz = $$baz++baz' = $$(baz "something")
+ data/examples/declaration/value/function/static-pointers-four-out.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE StaticPointers #-}++foo :: StaticPtr Int+foo = static 5++bar :: StaticPtr [Int]+bar =+    static+        [ 1+        , 2+        , 3+        ]++baz :: StaticPtr Bool+baz =+    static+        ( fun+            1+            2+        )
+ data/examples/declaration/value/function/strings-four-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE MagicHash #-}++foo = "foobar"+bar = "foo\&barbaz"+baz =+    "foo\+    \bar\+    \baz"
+ data/examples/declaration/value/function/tricky-parens-four-out.hs view
@@ -0,0 +1,4 @@+handleStuff =+    ( let foo = foo+       in foo+    )
+ data/examples/declaration/value/function/tuple-sections-four-out.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TupleSections #-}++foo = (,2)+bar = (,5,)+baz =+    (,,5,6,7,,,)
+ data/examples/declaration/value/function/tuples-four-out.hs view
@@ -0,0 +1,13 @@+foo = (1, 2, 3)+bar =+    ( 1+    , 2+    , 3+    )++handleStuff =+    ( let foo = foo+       in foo+    , let bar = bar+       in bar+    )
+ data/examples/declaration/value/function/type-applications-and-splice-four-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++staticKey name = [|sing @ $(symFQN name)|]
+ data/examples/declaration/value/function/type-applications-and-splice-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++staticKey name = [|sing @ $(symFQN name)|]
+ data/examples/declaration/value/function/type-applications-and-splice.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++staticKey name = [| sing @ $(symFQN name) |]
+ data/examples/declaration/value/function/type-applications-four-out.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE TypeApplications #-}++foo = f @String a b c++bar = f @(Maybe Int) a b++baz =+    f @Int @String+        a+        b++goo =+    hash+        @(HASH TPraosStandardCrypto)+        @ByteString+        "And the lamb lies down on Broadway"
+ data/examples/declaration/value/function/typed-expressions-four-out.hs view
@@ -0,0 +1,4 @@+foo x = x :: Int+bar x =+    Just x ::+        Maybe String
+ data/examples/declaration/value/function/typed-hole-four-out.hs view
@@ -0,0 +1,5 @@+foo = 1 `_` 2++bar = 1 `_a` 2++baz = _ `something` _
+ data/examples/declaration/value/function/unboxed-string-lit-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE MagicHash #-}++main = new "p"#
+ data/examples/declaration/value/function/unboxed-sums-four-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE UnboxedSums #-}++foo = (# 1 | #)+bar = (# | | 2 | #)+baz =+    (#+        | | | 10 | | | | |+    #)
+ data/examples/declaration/value/function/unboxed-tuples-four-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE UnboxedTuples #-}++foo = (# 1, 2, 3 #)+bar =+    (#+        1+        , 2+        , 3+    #)
+ data/examples/declaration/value/function/where-four-out.hs view
@@ -0,0 +1,19 @@+foo :: Int -> Int+foo x = f x where f z = z++bar :: Int -> Int+bar x = f x+  where+    f :: Int -> Int+    f z = z++baz :: Int -> Int+baz x = q+  where+    y = x+    z = y+    q = z++emptyWhere :: Int+emptyWhere = 5+  where
+ data/examples/declaration/value/function/where-nested-four-out.hs view
@@ -0,0 +1,12 @@+foo = bar+  where+    f1 = f1+      where+        f1 = 3+    f2 = f2+      where+        f2 = 3++foo2 = bar+  where+    f1 = f1 where { f1 = 3; f1' = 4 }; f2 = f2 where f2 = 3; f2' = 4
+ data/examples/declaration/value/other/comments-get-before-op-four-out.hs view
@@ -0,0 +1,10 @@+main :: IO ()+main = do+    migrateSchema+        [ migration1+        , migration1+        , migration3+        -- When adding migrations here, don't forget to update+        -- 'schemaVersion' in Galley.Data+        ]+        `finally` Log.close
+ data/examples/declaration/value/other/line-multi-line-four-out.hs view
@@ -0,0 +1,6 @@+x :: [Int]+x =+    [ 1+    , 2+    , somethingSomething 3+    ]
+ data/examples/declaration/value/other/line-single-line-four-out.hs view
@@ -0,0 +1,2 @@+x :: [Int]+x = [1, 2, 3]
+ data/examples/declaration/value/pattern-synonyms/bidirectional-four-out.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}++pattern Arrow t1 t2 = App "->" [t1, t2]+pattern Arrow{t1, t2} = App "->" [t1, t2]+pattern Arrow+    { t1+    , t2+    } =+    App "->" [t1, t2]+pattern Int =+    App "Int" []+pattern Maybe{t} =+    App+        "Maybe"+        [t]+pattern Maybe t =+    App+        "Maybe"+        [t]++pattern a :< b <-+    (a, b)
data/examples/declaration/value/pattern-synonyms/bidirectional.hs view
@@ -18,4 +18,3 @@  pattern a :< b <-   (a , b)-
+ data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-four-out.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE PatternSynonyms #-}++pattern P a <- C a where P a = C a++pattern HeadC x <-+    x : xs+    where+        HeadC x = [x]++pattern HeadC' x <-+    x : xs+    where+        HeadC' x = [x]++pattern Simple <-+    "Simple"+    where+        Simple = "Complicated"++pattern a :< b <-+    (a, b)+    where+        a :< b = (a, b)
data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-out.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE PatternSynonyms #-} +pattern P a <- C a where P a = C a+ pattern HeadC x <-   x : xs   where
data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE PatternSynonyms #-} +pattern P a <- C a where P a = C a+ pattern HeadC x <- x:xs where   HeadC x = [x] @@ -16,4 +18,3 @@   (a , b)   where     a :< b = (a, b)-
+ data/examples/declaration/value/pattern-synonyms/unidirectional-four-out.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE PatternSynonyms #-}++pattern Head x <- x : xs++pattern Head' x <-+    x : xs++pattern Head''{x} <-+    x : xs++pattern FirstTwo{x, y} <-+    x : (y : xs)++pattern FirstTwo'+    { x+    , y+    } <-+    x : (y : xs)++pattern Simple <- "Simple"++pattern WithTypeSig :: String+pattern WithTypeSig <- "WithTypeSig"
+ data/examples/declaration/warning/warning-multiline-four-out.hs view
@@ -0,0 +1,9 @@+{-# WARNING+    test+    , foo+    [ "These are bad functions"+    , "Really bad!"+    ]+    #-}+test :: IO ()+test = pure ()
+ data/examples/declaration/warning/warning-single-line-four-out.hs view
@@ -0,0 +1,13 @@+{-# DEPRECATED test, foo "This is a deprecation" #-}+{-# WARNING test "This is a warning" #-}+test :: IO ()+test = pure ()++bar = 3+{-# DEPRECATED bar "Bar is deprecated" #-}++{-# DEPRECATED baz "Baz is also deprecated" #-}+baz = 5++data Number = Number Dobule+{-# DEPRECATED Number "Use Scientific instead." #-}
+ data/examples/import/comments-inside-imports-four-out.hs view
@@ -0,0 +1,8 @@+import -- x+    Foo++import qualified -- x+    Bar++import qualified -- x+    Baz
+ data/examples/import/comments-per-import-four-out.hs view
@@ -0,0 +1,4 @@+-- (1)+import Bar -- (2)+import Baz -- (3)+import Foo
+ data/examples/import/deduplication-bug-four-out.hs view
@@ -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 (..))
+ data/examples/import/deduplication-bug-out.hs view
@@ -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 (..))
+ data/examples/import/deduplication-bug.hs view
@@ -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(..))
+ data/examples/import/explicit-imports-four-out.hs view
@@ -0,0 +1,12 @@+import qualified MegaModule as M (+    Either,+    Maybe (Just, Nothing),+    MaybeT (..),+    Monad (return, (>>), (>>=)),+    MonadBaseControl,+    join,+    liftIO,+    void,+    (<<<),+    (>>>),+ )
data/examples/import/explicit-imports-out.hs view
@@ -1,12 +1,12 @@ import qualified MegaModule as M-  ( (<<<),-    (>>>),-    Either,+  ( Either,     Maybe (Just, Nothing),     MaybeT (..),-    Monad ((>>), (>>=), return),+    Monad (return, (>>), (>>=)),     MonadBaseControl,     join,     liftIO,     void,+    (<<<),+    (>>>),   )
+ data/examples/import/explicit-imports-with-comments-four-out.hs view
@@ -0,0 +1,7 @@+import qualified MegaModule as M (+    -- (1)+    -- (2)+    Either, -- (3)+    (<<<),+    (>>>),+ )
data/examples/import/explicit-imports-with-comments-out.hs view
@@ -1,6 +1,7 @@ import qualified MegaModule as M   ( -- (1)-    (<<<), -- (2)-    (>>>),+    -- (2)     Either, -- (3)+    (<<<),+    (>>>),   )
+ data/examples/import/explicit-prelude-four-out.hs view
@@ -0,0 +1,3 @@+import Aaa+import Zzz+import Prelude
+ data/examples/import/merging-0-four-out.hs view
@@ -0,0 +1,3 @@+import Foo+import Foo (bar, foo)+import Foo as F
+ data/examples/import/merging-0-out.hs view
@@ -0,0 +1,3 @@+import Foo+import Foo (bar, foo)+import Foo as F
+ data/examples/import/merging-0.hs view
@@ -0,0 +1,4 @@+import Foo+import Foo (foo)+import Foo (bar)+import Foo as F
+ data/examples/import/merging-1-four-out.hs view
@@ -0,0 +1,2 @@+import "bar" Foo (bar)+import "foo" Foo (baz, foo)
+ data/examples/import/merging-1-out.hs view
@@ -0,0 +1,2 @@+import "bar" Foo (bar)+import "foo" Foo (baz, foo)
+ data/examples/import/merging-1.hs view
@@ -0,0 +1,3 @@+import "foo" Foo (foo)+import "bar" Foo (bar)+import "foo" Foo (baz)
+ data/examples/import/merging-2-four-out.hs view
@@ -0,0 +1,2 @@+import Foo hiding (bar4, foo2)+import qualified Foo (bar3, foo1)
+ data/examples/import/merging-2-out.hs view
@@ -0,0 +1,2 @@+import Foo hiding (bar4, foo2)+import qualified Foo (bar3, foo1)
+ data/examples/import/merging-2.hs view
@@ -0,0 +1,4 @@+import qualified Foo (foo1)+import Foo hiding (foo2)+import qualified Foo (bar3)+import Foo hiding (bar4)
+ data/examples/import/misc-four-out.hs view
@@ -0,0 +1,7 @@+import A hiding (+    foobarbazqux,+ )++import Name hiding ()++import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)
data/examples/import/misc-out.hs view
@@ -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 ()
+ data/examples/import/nested-explicit-imports-four-out.hs view
@@ -0,0 +1,10 @@+import qualified MegaModule as M (+    Either,+    Monad (+        return,+        (>>),+        (>>=)+    ),+    (<<<),+    (>>>),+ )
data/examples/import/nested-explicit-imports-out.hs view
@@ -1,10 +1,10 @@ import qualified MegaModule as M-  ( (<<<),-    (>>>),-    Either,+  ( Either,     Monad-      ( (>>),-        (>>=),-        return+      ( return,+        (>>),+        (>>=)       ),+    (<<<),+    (>>>),   )
+ data/examples/import/qualified-post-four-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ImportQualifiedPost #-}++import Data.Text qualified (a, b, c)+import Data.Text qualified hiding (a, b, c)+import Data.Text qualified as T
data/examples/import/qualified-post-out.hs view
@@ -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
+ data/examples/import/qualified-prelude-four-out.hs view
@@ -0,0 +1,4 @@+module P where++import Prelude hiding (id, (.))+import qualified Prelude
data/examples/import/qualified-prelude-out.hs view
@@ -1,4 +1,4 @@ module P where +import Prelude hiding (id, (.)) import qualified Prelude-import Prelude hiding ((.), id)
+ data/examples/import/simple-four-out.hs view
@@ -0,0 +1,5 @@+import Data.Text+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
data/examples/import/simple-out.hs view
@@ -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
data/examples/import/simple.hs view
@@ -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)
+ data/examples/import/sorted-export-list-four-out.hs view
@@ -0,0 +1,1 @@+import Linear.Vector (Additive (..), (*^), (^*))
+ data/examples/import/sorted-export-list-out.hs view
@@ -0,0 +1,1 @@+import Linear.Vector (Additive (..), (*^), (^*))
+ data/examples/import/sorted-export-list.hs view
@@ -0,0 +1,1 @@+import Linear.Vector (Additive (..), (*^), (^*))
+ data/examples/import/sorted-four-out.hs view
@@ -0,0 +1,3 @@+import A+import B+import C
+ data/examples/module-header/double-dot-with-names-four-out.hs view
@@ -0,0 +1,17 @@+{-# LANGUAGE PatternSynonyms #-}++module ExportSyntax (A (.., NoA), Q (F, ..), G (T, .., U)) where++data A = A | B++pattern NoA = B++data Q a = Q a++pattern F a = Q a++data G = G | H++pattern T = G++pattern U = H
+ data/examples/module-header/double-shebangs-four-out.hs view
@@ -0,0 +1,2 @@+#!/usr/bin/env stack+#!/usr/bin/env stack
+ data/examples/module-header/empty-four-out.hs view
+ data/examples/module-header/leading-empty-line-four-out.hs view
@@ -0,0 +1,12 @@+{- |+ Module      :  Text.Megaparsec+ Copyright   :  © 2015–2019 Megaparsec contributors+                © 2007 Paolo Martini+                © 1999–2001 Daan Leijen+ License     :  FreeBSD++ Maintainer  :  Mark Karpov <markkarpov92@gmail.com>+ Stability   :  experimental+ Portability :  portable+-}+module Main where
+ data/examples/module-header/multiline-empty-four-out.hs view
@@ -0,0 +1,2 @@+module Foo (+    ) where
+ data/examples/module-header/multiline-four-out.hs view
@@ -0,0 +1,5 @@+module Foo (+    foo,+    bar,+    baz,+) where
+ data/examples/module-header/multiline-with-comments-four-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-}++-- | Header.+module My.Module (+    -- * Something+    foo,+    bar,++    -- * Another thing+    (<?>),+    {- some other thing -} foo2, -- yet another+    foo3, -- third one+    baz,+    bar2, -- a multiline comment+    -- the second line+    bar3,+    module Foo.Bar.Baz,+) where++-- Wow
+ data/examples/module-header/multiline2-four-out.hs view
@@ -0,0 +1,5 @@+module Foo (+    foo,+    bar,+    baz,+) where
+ data/examples/module-header/named-section-four-out.hs view
@@ -0,0 +1,13 @@+module Magic (+    -- * Something+    -- $explanation++    -- ** Another level+    foo,+    bar,+) where++{- $explanation++ Here it goes.+-}
+ data/examples/module-header/preceding-comment-with-haddock-four-out.hs view
@@ -0,0 +1,8 @@+{-+   Here we go.+-}++-- | This is the module's Haddock.+module Main (main) where++main = return ()
+ data/examples/module-header/shebang-four-out.hs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++import Prelude++main :: IO ()+main = putStrLn "hello world"
+ data/examples/module-header/shebang-with-pragmas-four-out.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env stack++{-# LANGUAGE OverloadedStrings #-}++main = pure ()
+ data/examples/module-header/simple-four-out.hs view
@@ -0,0 +1,1 @@+module Main where
+ data/examples/module-header/simple-with-comments-four-out.hs view
@@ -0,0 +1,4 @@+-- | Here we go.+module Main where++-- Wow.
+ data/examples/module-header/singleline-empty-four-out.hs view
@@ -0,0 +1,2 @@+-- | This demonstrates a BUG.+module Foo () where
+ data/examples/module-header/singleline-four-out.hs view
@@ -0,0 +1,1 @@+module Foo (foo, bar, baz) where
+ data/examples/module-header/stack-header-0-four-out.hs view
@@ -0,0 +1,7 @@+-- stack runhaskell++{-# LANGUAGE OverloadedStrings #-}++main = return ()++-- stack runhaskell
+ data/examples/module-header/stack-header-1-four-out.hs view
@@ -0,0 +1,8 @@+#!/usr/bin/env stack+-- stack runhaskell++{-# LANGUAGE OverloadedStrings #-}++main = return ()++-- stack runhaskell
+ data/examples/module-header/stack-header-2-four-out.hs view
@@ -0,0 +1,12 @@+#!/usr/bin/env stack+{- stack+  script+  --resolver lts-6.25+  --package turtle+  --package "stm async"+  --package http-client,http-conduit+-}++{-# LANGUAGE OverloadedStrings #-}++main = return ()
+ data/examples/module-header/warning-pragma-four-out.hs view
@@ -0,0 +1,5 @@+module Test+    {-# WARNING+        "This module is very internal"+        #-}+where
+ data/examples/module-header/warning-pragma-list-multiline-four-out.hs view
@@ -0,0 +1,11 @@+module Test+    {-# DEPRECATED+        [ "This module is deprecated."+        , "Please use OtherModule instead."+        ]+        #-}+    (+    foo,+    bar,+    baz,+) where
+ data/examples/module-header/warning-pragma-multiline-four-out.hs view
@@ -0,0 +1,5 @@+module Test+    {-# DEPRECATED "This module is unstable" #-}+    (foo, bar, baz) where++import Blah
+ data/examples/module-header/warning-pragma-singleton-list-four-out.hs view
@@ -0,0 +1,2 @@+module Test {-# WARNING "There's only one line here." #-}+where
+ data/examples/other/argument-comment-four-out.hs view
@@ -0,0 +1,16 @@+foo ::+    -- | Documentation+    Int ->+    Bool+foo _ = True++foo ::+    Foo a =>+    -- | Foo+    Int ->+    Int+foo ::+    Foo a =>+    -- | Foo+    Int ->+    Int
data/examples/other/argument-comment-out.hs view
@@ -9,7 +9,6 @@   -- | Foo   Int ->   Int- foo ::   Foo a =>   -- | Foo
+ data/examples/other/ascii-four-out.hs view
@@ -0,0 +1,9 @@+{- -----------------------------------+  < What about ASCII art in comments? >+   -----------------------------------+          \   ^__^+           \  (oo)\_______+              (__)\       )\/\+                  ||----w |+                  ||     ||+-}
+ data/examples/other/comment-after-preceding-haddock-four-out.hs view
@@ -0,0 +1,12 @@+module Main where++-- | A++-- B++type D = E++-- | This is 'f'++--     * Comment+f :: a -> b
+ data/examples/other/comment-alignment-four-out.hs view
@@ -0,0 +1,9 @@+class Foo a where+    -- | Foo.+    foo ::+        Int ->+        -- | Something+        a++    -- | Bar.+    bar :: a
+ data/examples/other/comment-before-hanging-four-out.hs view
@@ -0,0 +1,5 @@+x = Just+    -- comment+    do+        foo+        bar
+ data/examples/other/comment-following-preceding-gap-four-out.hs view
@@ -0,0 +1,6 @@+foo = bar+  where+    baz = return (quux) -- Foo++    -- Bar+    meme = gege
+ data/examples/other/comment-glued-together-four-out.hs view
@@ -0,0 +1,7 @@+module Main (main) where++-- | Foo.++-- Bar+main :: IO ()+main = return ()
+ data/examples/other/comment-glued-together-out.hs view
@@ -0,0 +1,7 @@+module Main (main) where++-- | Foo.++-- Bar+main :: IO ()+main = return ()
+ data/examples/other/comment-glued-together.hs view
@@ -0,0 +1,6 @@+module Main (main) where++{- | Foo. -}+-- Bar+main :: IO ()+main = return ()
+ data/examples/other/comment-inside-construct-four-out.hs view
@@ -0,0 +1,9 @@+xs =+    [ outer list item+    ,+        [ inner list first item+        , inner list second item+        -- inner list last item commented+        ]+    , outer list item+    ]
+ data/examples/other/comment-multiline-after-four-out.hs view
@@ -0,0 +1,7 @@+foo ::+    -- | start index+    Int ->+    -- | length+    Int ->+    t a ->+    t a
+ data/examples/other/comment-style-transform-four-out.hs view
@@ -0,0 +1,19 @@+{- |+Module:      Data.Aeson.TH+Copyright:   (c) 2011-2016 Bryan O'Sullivan+             (c) 2011 MailRank, Inc.+License:     BSD3+Stability:   experimental+Portability: portable+-}+module Main where++{- |++Here is a snippet:++@+x = y + 2+@+-}+x = y + 2
data/examples/other/comment-style-transform-out.hs view
@@ -1,17 +1,17 @@ -- |--- Module:      Data.Aeson.TH--- Copyright:   (c) 2011-2016 Bryan O'Sullivan---              (c) 2011 MailRank, Inc.--- License:     BSD3--- Stability:   experimental--- Portability: portable+--Module:      Data.Aeson.TH+--Copyright:   (c) 2011-2016 Bryan O'Sullivan+--             (c) 2011 MailRank, Inc.+--License:     BSD3+--Stability:   experimental+--Portability: portable module Main where  -- | ----- Here is a snippet:+--Here is a snippet: ----- @--- x = y + 2--- @+--@+--x = y + 2+--@ x = y + 2
+ data/examples/other/comment-trailing-space-four-out.hs view
@@ -0,0 +1,9 @@+data T+    = {-++        some multi-line comment++        with empty lines++      -}+      A
+ data/examples/other/comment-trailing-space-out.hs view
@@ -0,0 +1,9 @@+data T+  = {-++      some multi-line comment++      with empty lines++    -}+    A
+ data/examples/other/comment-trailing-space.hs view
@@ -0,0 +1,9 @@+data T+  = {-++      some multi-line comment++      with empty lines++    -}+    A
+ data/examples/other/comment-two-blocks-four-out.hs view
@@ -0,0 +1,8 @@+newNames :: [(String, String)]+newNames =+    let (*) = flip (,)+     in [ "Control" * "Monad"+    -- Foo++    -- Bar+        ]
+ data/examples/other/consequetive-pipe-comments-four-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Foo.++-- | Bar.+bar :: Int+bar = 5
+ data/examples/other/empty-forall-four-out.hs view
@@ -0,0 +1,18 @@+-- Empty foralls are handled correctly in different situations.++data D = forall. D Int++data G where+    G :: forall. Int -> G++f :: forall. a -> a+f x = x++type family T x where+    forall. T x = x++{-# RULES+"r"+    r a =+        ()+    #-}
+ data/examples/other/empty-haddock-four-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- |+foo :: Int+foo = 5
+ data/examples/other/following-comment-last-0-four-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Another datatype...+data D'+-- ^ ...with two docstrings.
+ data/examples/other/following-comment-last-1-four-out.hs view
@@ -0,0 +1,8 @@+module Main where++-- | Another datatype...+data D'+    deriving (Show)+-- ^ ...with two docstrings.++-- more
+ data/examples/other/following-comment-last-2-four-out.hs view
@@ -0,0 +1,10 @@+module Main where++-- | Another datatype...+data D'+    deriving (Show)+-- ^ ...with two docstrings.++-- more++data B
+ data/examples/other/following-comment-last-3-four-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Another datatype...+data D'+{- ^ ...with two docstrings.+ even on second line+-}
+ data/examples/other/haddock-sections-four-out.hs view
@@ -0,0 +1,9 @@+{- $weird #anchor#++ Section 1+-}++{- $normal++ Section 2+-}
+ data/examples/other/inline-comment-0-four-out.hs view
@@ -0,0 +1,3 @@+x = ({-a-} b, c)++y = ({-a-} b)
+ data/examples/other/inline-comment-1-four-out.hs view
@@ -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
+ data/examples/other/list-multiline-four-out.hs view
@@ -0,0 +1,8 @@+x =+    [ [1, 2]+    ,+        [ 2+        , 3+        ]+    , [3, 4]+    ]
+ data/examples/other/list-multiline-out.hs view
@@ -0,0 +1,7 @@+x =+  [ [1, 2],+    [ 2,+      3+    ],+    [3, 4]+  ]
+ data/examples/other/list-multiline.hs view
@@ -0,0 +1,6 @@+x =+    [ [1, 2]+    , [2,+          3]+    , [3, 4]+    ]
+ data/examples/other/merging-comments-four-out.hs view
@@ -0,0 +1,12 @@+foo xs = baz+  where+    bar =+        catMaybes+            [ lookup langKey gets -- 1+            , lookup langKey cookies -- 2+            , lookupText langKey session -- 3+            ]+            ++ xs -- 4++    -- Blah+    baz = addTwoLetters (id, Set.empty) bar
+ data/examples/other/multiline-comments-reindent-four-out.hs view
@@ -0,0 +1,6 @@+{-+   And so here we have a+     multiline comment.++   Indeed.+-}
+ data/examples/other/multiline-forall-four-out.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}++-- Multiline foralls are consistent across all declarations++data D+    = forall+        ( f ::+            * -> * -> *+        )+        (x :: *)+        (y :: *).+        D (f x y)++data G where+    G ::+        forall+            ( f ::+                * -> * -> *+            )+            (x :: *)+            (y :: *).+        f x y ->+        G++f ::+    forall+        ( f ::+            * -> * -> *+        )+        (x :: *)+        (y :: *).+    f x y ->+    ()+f = const ()++type family T f x y where+    forall+        ( f ::+            * -> * -> *+        )+        (x :: *)+        (y :: *).+        T f x y =+            f x y++{-# RULES+"r" forall+    ( f ::+        * -> * -> *+    )+    (x :: *)+    (y :: *).+    r (a :: f x y) =+        ()+    #-}
+ data/examples/other/multiple-blank-line-comment-four-out.hs view
@@ -0,0 +1,9 @@+module A where++a =+    b+        [ f+        {-,++                                           -}+        ]
+ data/examples/other/overly-indented-four-out.hs view
@@ -0,0 +1,11 @@+tagCloudField ::+    -- | Destination key+    String ->+    -- | Smallest font size, in percent+    Double ->+    -- | Biggest font size, in percent+    Double ->+    -- | Input tags+    Tags ->+    -- | Context+    Context a
+ data/examples/other/pragma-comments-after-four-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+-- TODO: Fix and delete this pragma+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+ data/examples/other/pragma-comments-after-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+-- TODO: Fix and delete this pragma+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
+ data/examples/other/pragma-comments-after.hs view
@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- TODO: Fix and delete this pragma+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}
+ data/examples/other/pragma-comments-four-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE OverloadedStrings #-}+-- TODO This extension is probably too dangerous, remove it.+{-# LANGUAGE RecordWildCards #-}+-- Avoid warning produced by TH.+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}++-- | Header comment.+module Foo () where
+ data/examples/other/pragma-four-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -O2 -H 300 #-}+{-# OPTIONS_GHC -Wall -Werror #-}+{-# OPTIONS_HADDOCK prune, show-extensions #-}++-- | Header comment.+module Foo () where
+ data/examples/other/pragma-no-header-four-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}
+ data/examples/other/pragma-sorting-four-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE NondecreasingIndentation #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+-- This gap is necessary for stylish Haskell not to re-arrange+-- NoMonoLocalBinds before TypeFamilies+{-# LANGUAGE NoMonoLocalBinds #-}++module Foo (+    bar,+) where
+ data/examples/other/trailing-whitespace-four-out.hs view
@@ -0,0 +1,7 @@+-- Here is a comment with trailing whitespace.+foo = 5++{- Block comment with trailing whitespace.+   Bo.+  -}+bar = 6
fourmolu.cabal view
@@ -1,10 +1,13 @@ cabal-version:   1.18 name:            fourmolu-version:         0.1.0.0+version:         0.2.0.0 license:         BSD3 license-file:    LICENSE.md-maintainer:      Matt Parsons <parsonsmatt@gmail.com>, George Thomas <georgefsthomas@gmail.com>-tested-with:     ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1+maintainer:+    Matt Parsons <parsonsmatt@gmail.com>+    George Thomas <georgefsthomas@gmail.com>++tested-with:     ghc ==8.6.5 ghc ==8.8.4 ghc ==8.10.1 homepage:        https://github.com/parsonsmatt/fourmolu bug-reports:     https://github.com/parsonsmatt/fourmolu/issues synopsis:        A formatter for Haskell source code@@ -50,9 +53,7 @@     data/examples/other/*.hs  extra-doc-files:-    CONTRIBUTING.md     CHANGELOG.md-    DESIGN.md     README.md  source-repository head@@ -120,15 +121,16 @@         base >=4.12 && <5.0,         bytestring >=0.2 && <0.11,         containers >=0.5 && <0.7,-        directory >= 1.3.5 && <1.4,-        dlist >=0.8 && <0.9,+        directory >=1.3.3 && <1.4,+        dlist >=0.8 && <2.0,         exceptions >=0.6 && <0.11,         filepath >=1.4.2.1 && <1.5,         ghc-lib-parser >=8.10 && <8.11,+        HsYAML >=0.2 && <0.3,+        HsYAML-aeson >=0.2 && <0.3,         mtl >=2.0 && <3.0,         syb >=0.7 && <0.8,-        text >=0.2 && <1.3,-        yaml >=0.11.2 && <0.12+        text >=0.2 && <1.3      if flag(dev)         ghc-options:@@ -145,17 +147,19 @@     other-modules:    Paths_fourmolu     default-language: Haskell2010     build-depends:+        fourmolu -any,         base >=4.12 && <5.0,+        directory >=1.3.3 && <1.4,         ghc-lib-parser >=8.10 && <8.11,         gitrev >=1.3 && <1.4,-        optparse-applicative >=0.14 && <0.16,-        fourmolu -any,+        optparse-applicative >=0.14 && <0.17,         text >=0.2 && <1.3      if flag(dev)         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
src/Ormolu.hs view
@@ -10,8 +10,13 @@     defaultConfig,     DynOption (..),     PrinterOpts (..),+    PrinterOptsPartial,+    PrinterOptsTotal,     defaultPrinterOpts,     loadConfigFile,+    ConfigFileLoadResult (..),+    configFileName,+    fillMissingPrinterOpts,     OrmoluException (..),     withPrettyOrmoluExceptions,   )
src/Ormolu/Config.hs view
@@ -1,7 +1,11 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}  -- | Configuration options used by the tool. module Ormolu.Config@@ -10,37 +14,43 @@     RegionDeltas (..),     defaultConfig,     PrinterOpts (..),+    PrinterOptsPartial,+    PrinterOptsTotal,     defaultPrinterOpts,     loadConfigFile,+    configFileName,+    ConfigFileLoadResult (..),+    fillMissingPrinterOpts,+    CommaStyle (..),+    HaddockPrintStyle (..),     regionIndicesToDeltas,     DynOption (..),     dynOptionToLocatedStr,   ) where -import Control.Monad (when) import Data.Aeson   ( FromJSON (..),     camelTo2,+    constructorTagModifier,     defaultOptions,     fieldLabelModifier,     genericParseJSON,-    rejectUnknownFields,   )-import Data.List (stripPrefix)-import Data.Maybe (fromMaybe)-import Data.Yaml (decodeFileEither, prettyPrintParseException)+import qualified Data.ByteString.Lazy as BS+import Data.Char (isLower)+import Data.Functor.Identity (Identity (..))+import Data.YAML (Pos)+import Data.YAML.Aeson (decode1) import GHC.Generics (Generic) import qualified SrcLoc as GHC import System.Directory   ( XdgDirectory (XdgConfig),     findFile,-    getCurrentDirectory,     getXdgDirectory,     makeAbsolute,   )-import System.FilePath ((</>), splitPath)-import System.IO (hPutStrLn, stderr)+import System.FilePath (splitPath, (</>))  -- | Ormolu configuration. data Config region = Config@@ -54,7 +64,7 @@     cfgCheckIdempotence :: !Bool,     -- | Region selection     cfgRegion :: !region,-    cfgPrinterOpts :: PrinterOpts+    cfgPrinterOpts :: !PrinterOptsTotal   }   deriving (Eq, Show, Functor) @@ -93,16 +103,104 @@       cfgPrinterOpts = defaultPrinterOpts     } --- | Options controlling formatting output-data PrinterOpts = PrinterOpts+-- | Options controlling formatting output.+data PrinterOpts f = PrinterOpts   { -- | Number of spaces to use for indentation-    poIndentStep :: Int+    poIndentation :: f Int,+    -- | Whether to place commas at start or end of lines+    poCommaStyle :: f CommaStyle,+    -- | Whether to indent `where` blocks+    poIndentWheres :: f Bool,+    -- | Leave space before opening record brace+    poRecordBraceSpace :: f Bool,+    -- | Trailing commas with parentheses on separate lines+    poDiffFriendlyImportExport :: f Bool,+    -- | Be less opinionated about spaces/newlines etc.+    poRespectful :: f Bool,+    -- | How to print doc comments+    poHaddockStyle :: f HaddockPrintStyle   }-  deriving (Eq, Show)+  deriving (Generic) -defaultPrinterOpts :: PrinterOpts-defaultPrinterOpts = PrinterOpts {poIndentStep = 4}+-- | A version of 'PrinterOpts' where any field can be empty.+-- This corresponds to the information in a config file or in CLI options.+type PrinterOptsPartial = PrinterOpts Maybe +deriving instance Eq PrinterOptsPartial++deriving instance Show PrinterOptsPartial++instance Semigroup PrinterOptsPartial where+  (<>) = fillMissingPrinterOpts++instance Monoid PrinterOptsPartial where+  mempty = PrinterOpts Nothing Nothing Nothing Nothing Nothing Nothing Nothing++-- | A version of 'PrinterOpts' without empty fields.+type PrinterOptsTotal = PrinterOpts Identity++deriving instance Eq PrinterOptsTotal++deriving instance Show PrinterOptsTotal++defaultPrinterOpts :: PrinterOptsTotal+defaultPrinterOpts =+  PrinterOpts+    { poIndentation = pure 4,+      poCommaStyle = pure Leading,+      poIndentWheres = pure False,+      poRecordBraceSpace = pure False,+      poDiffFriendlyImportExport = pure True,+      poRespectful = pure True,+      poHaddockStyle = pure HaddockMultiLine+    }++-- | Fill the field values that are 'Nothing' in the first argument+-- with the values of the corresponding fields of the second argument.+fillMissingPrinterOpts ::+  forall f.+  Applicative f =>+  PrinterOptsPartial ->+  PrinterOpts f ->+  PrinterOpts f+fillMissingPrinterOpts p1 p2 =+  PrinterOpts+    { poIndentation = fillField poIndentation,+      poCommaStyle = fillField poCommaStyle,+      poIndentWheres = fillField poIndentWheres,+      poRecordBraceSpace = fillField poRecordBraceSpace,+      poDiffFriendlyImportExport = fillField poDiffFriendlyImportExport,+      poRespectful = fillField poRespectful,+      poHaddockStyle = fillField poHaddockStyle+    }+  where+    fillField :: (forall g. PrinterOpts g -> g a) -> f a+    fillField f = maybe (f p2) pure $ f p1++data CommaStyle+  = Leading+  | Trailing+  deriving (Eq, Ord, Show, Generic)++instance FromJSON CommaStyle where+  parseJSON =+    genericParseJSON+      defaultOptions+        { constructorTagModifier = camelTo2 '-'+        }++data HaddockPrintStyle+  = HaddockSingleLine+  | HaddockMultiLine+  deriving (Eq, Ord, Show, Generic)++instance FromJSON HaddockPrintStyle where+  parseJSON =+    genericParseJSON+      defaultOptions+        { constructorTagModifier = drop (length "haddock-") . camelTo2 '-'+        }+ -- | Convert 'RegionIndices' into 'RegionDeltas'. regionIndicesToDeltas ::   -- | Total number of lines in the input@@ -127,54 +225,35 @@ dynOptionToLocatedStr :: DynOption -> GHC.Located String dynOptionToLocatedStr (DynOption o) = GHC.L GHC.noSrcSpan o --- | A version of 'PrinterOpts' where any field can be empty.--- This corresponds to the information in a config file.-data PrinterOptsPartial = PrinterOptsPartial-  { popIndentation :: Maybe Int-  }-  deriving (Eq, Show, Generic)- instance FromJSON PrinterOptsPartial where   parseJSON =     genericParseJSON       defaultOptions-        { rejectUnknownFields = True,-          fieldLabelModifier = camelTo2 '_' . fromMaybe "" . stripPrefix "pop"+        { fieldLabelModifier = camelTo2 '-' . dropWhile isLower         } --- | Replace fields with those from a config file, if found.+-- | Read options from a config file, if found. -- Looks recursively in parent folders, then in 'XdgConfig',--- for a file matching /fourmolu.yaml/'.-loadConfigFile :: Bool -> Maybe FilePath -> PrinterOpts -> IO PrinterOpts-loadConfigFile debug maybePath PrinterOpts {..} = do-  root <- maybe getCurrentDirectory makeAbsolute maybePath+-- for a file named /fourmolu.yaml/.+loadConfigFile :: FilePath -> IO ConfigFileLoadResult+loadConfigFile path = do+  root <- makeAbsolute path   xdg <- getXdgDirectory XdgConfig ""-  PrinterOptsPartial {..} <--    optsFromFile debug $ reverse $ xdg : scanl1 (</>) (splitPath root)-  return $-    PrinterOpts-      { poIndentStep = fromMaybe poIndentStep popIndentation-      }---- | Search the directories, in order, for a config file.-optsFromFile :: Bool -> [FilePath] -> IO PrinterOptsPartial-optsFromFile debug dirs =+  let dirs = reverse $ xdg : scanl1 (</>) (splitPath root)   findFile dirs configFileName >>= \case-    Nothing -> do-      printDebug $-        "No " ++ show configFileName ++ " found in any of:\n"-          ++ unlines (map ("  " ++) dirs)-      return def-    Just file -> do-      printDebug $ "Found " ++ show file ++ ""-      decodeFileEither file >>= \case-        Left e -> do-          printDebug $ prettyPrintParseException e-          return def-        Right x -> return x-  where-    def = PrinterOptsPartial Nothing-    printDebug = when debug . hPutStrLn stderr+    Nothing -> return $ ConfigNotFound dirs+    Just file ->+      either (ConfigParseError file) (ConfigLoaded file)+        . decode1+        <$> BS.readFile file +-- | The result of calling 'loadConfigFile'.+data ConfigFileLoadResult+  = ConfigLoaded FilePath PrinterOptsPartial+  | ConfigParseError FilePath (Pos, String)+  | ConfigNotFound [FilePath]+  deriving (Eq, Show)++-- | Expected file name for YAML config. configFileName :: FilePath configFileName = "fourmolu.yaml"
src/Ormolu/Diff.hs view
@@ -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 = concat . normalizeImports False $ hsmodImports hs0}+        hs1 {hsmodImports = concat . normalizeImports False $ hsmodImports hs1}  -- | Compare two values for equality disregarding differences in 'SrcSpan's -- and the ordering of import lists.
src/Ormolu/Imports.hs view
@@ -4,82 +4,205 @@  -- | Manipulations on import lists. module Ormolu.Imports-  ( sortImports,+  ( normalizeImports,   ) where  import Data.Bifunctor+import Data.Char (isAlphaNum)+import Data.Foldable (toList) 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 (groupBy', notImplemented, separatedByBlank, 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, group and normalize imports. Assumes input list is sorted by source location.+normalizeImports :: Bool -> [LImportDecl GhcPs] -> [[LImportDecl GhcPs]]+normalizeImports preserveGroups =+  map+    ( fmap snd+        . M.toAscList+        . M.fromListWith combineImports+        . fmap (\x -> (importId x, g x))+    )+    . if preserveGroups+      then map toList . groupBy' (\x y -> not $ separatedByBlank getLoc x y)+      else pure   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
src/Ormolu/Parser.hs view
@@ -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) 
src/Ormolu/Parser/CommentStream.hs view
@@ -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  ----------------------------------------------------------------------------@@ -85,7 +86,7 @@  -- | 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+-- 'NonEmpty' list inside contains lines of multiline comment @{\- … -\}@ or -- just single item\/line otherwise. data Comment = Comment Bool (NonEmpty String)   deriving (Eq, Show, Data)@@ -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
src/Ormolu/Parser/Result.hs view
@@ -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'.
src/Ormolu/Printer.hs view
@@ -19,14 +19,14 @@ printModule ::   -- | Result of parsing   ParseResult ->-  PrinterOpts ->+  PrinterOptsTotal ->   -- | Resulting rendition   Text printModule ParseResult {..} printerOpts =   prLiteralPrefix <> region <> prLiteralSuffix   where     region =-      postprocess $+      postprocess prIndent $         runR           ( p_hsModule               prStackHeader
src/Ormolu/Printer/Combinators.hs view
@@ -21,6 +21,8 @@     space,     newline,     inci,+    inciIf,+    inciBy,     located,     located',     switchLayout,@@ -29,6 +31,7 @@     getLayout,     breakpoint,     breakpoint',+    getPrinterOpt,      -- ** Formatting lists     sep,@@ -51,6 +54,7 @@      -- ** Literals     comma,+    commaDel,     equals,      -- ** Stateful markers@@ -65,6 +69,7 @@ import Control.Monad import Data.List (intersperse) import Data.Text (Text)+import Ormolu.Config import Ormolu.Printer.Comments import Ormolu.Printer.Internal import SrcLoc@@ -72,6 +77,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 +188,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 +206,7 @@     N   | -- | Shifted one level     S+  deriving (Eq, Show)  -- | Surround given entity by backticks. backticks :: R () -> R ()@@ -218,7 +235,7 @@ parensHash :: BracketStyle -> R () -> R () parensHash = brackets_ True "(#" "#)" --- | Braces as used for pragmas: @{-#@ and @#-}@.+-- | Braces as used for pragmas: @{\-#@ and @#-\}@. pragmaBraces :: R () -> R () pragmaBraces m = sitcc $ do   txt "{-#"@@ -262,13 +279,18 @@       txt close     multiLine = do       txt open-      if needBreaks-        then newline >> inci m-        else space >> sitcc m+      commaStyle <- getPrinterOpt poCommaStyle+      case commaStyle of+        Leading ->+          if needBreaks+            then inci $ newline >> m+            else inciIf (style == S) $ space >> m+        Trailing ->+          if needBreaks+            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 +298,13 @@ -- | Print @,@. comma :: R () comma = txt ","++-- | Delimiting combination with 'comma'. To be used with 'sep'.+commaDel :: R ()+commaDel =+  getPrinterOpt poCommaStyle >>= \case+    Leading -> breakpoint' >> comma >> space+    Trailing -> comma >> breakpoint  -- | Print @=@. Do not use @'txt' "="@. equals :: R ()
src/Ormolu/Printer/Comments.hs view
@@ -154,6 +154,7 @@   -- | Last printed comment span   Maybe SpanMark ->   Bool+needsNewlineBefore _ (Just (HaddockSpan _ _)) = True needsNewlineBefore l mlastMark =   case spanMarkSpan <$> mlastMark of     Nothing -> False@@ -231,18 +232,17 @@           let startColumn = srcLocCol . realSrcSpanStart            in startColumn espn > startColumn ref                 || ( abs (startColumn espn - startColumn l)-                       >= abs (startColumn ref - startColumn l)+                      >= abs (startColumn ref - startColumn l)                    )     continuation =       -- 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+              Just (HaddockSpan _ _) -> False+              Just (CommentSpan spn) ->+                srcSpanEndLine spn + 1 == srcSpanStartLine l+              _ -> False            )     lastInEnclosing =       case meSpn of
src/Ormolu/Printer/Internal.hs view
@@ -20,11 +20,13 @@     newline,     useRecordDot,     inci,+    inciBy,     sitcc,     Layout (..),     enterLayout,     vlayout,     getLayout,+    getPrinterOpt,      -- * Helpers for braces     useBraces,@@ -57,6 +59,7 @@ import Control.Monad.State.Strict import Data.Bool (bool) import Data.Coerce+import Data.Functor.Identity (runIdentity) import Data.Maybe (listToMaybe) import Data.Text (Text) import qualified Data.Text as T@@ -94,7 +97,7 @@     rcCanUseBraces :: Bool,     -- | Whether the source could have used the record dot preprocessor     rcUseRecDot :: Bool,-    rcPrinterOpts :: PrinterOpts+    rcPrinterOpts :: PrinterOptsTotal   }  -- | State context of 'R'.@@ -160,7 +163,7 @@   CommentStream ->   -- | Annotations   Anns ->-  PrinterOpts ->+  PrinterOptsTotal ->   -- | Use Record Dot Syntax   Bool ->   -- | Resulting rendition@@ -224,7 +227,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 ->@@ -247,6 +251,7 @@   -- | 'Text' to output   Text ->   R ()+spit _ "" = return () spit stype text = do   requestedDel <- R (gets scRequestedDelimiter)   pendingComments <- R (gets scPendingComments)@@ -377,13 +382,19 @@ -- to be valid Haskell. When layout is single-line there is no obvious -- effect, but with multi-line layout correct indentation levels matter. inci :: R () -> R ()-inci (R m) = do-  indentStep <- R (asks (poIndentStep . rcPrinterOpts))+inci = inciBy 1++-- | Like 'inci', but indents by the given fraction of a full step.+inciBy :: Int -> R () -> R ()+inciBy x (R m) = do+  step <- (`quot` x) <$> R (asks (runIdentity . poIndentation . rcPrinterOpts))   let modRC rc =         rc-          { rcIndent = rcIndent rc + indentStep+          { rcIndent = roundDownToNearest step (rcIndent rc) + step           }   R (local modRC m)+  where+    roundDownToNearest r n = (n `div` r) * r  -- | Set indentation level for the inner computation equal to current -- column. This makes sure that the entire inner block is uniformly@@ -424,6 +435,10 @@ -- | Get current 'Layout'. getLayout :: R Layout getLayout = R (asks rcLayout)++-- | Get a particular 'PrinterOpts' field from the environment.+getPrinterOpt :: (forall f. PrinterOpts f -> f a) -> R a+getPrinterOpt f = R $ asks $ runIdentity . f . rcPrinterOpts  ---------------------------------------------------------------------------- -- Special helpers for comment placement
src/Ormolu/Printer/Meat/Common.hs view
@@ -11,16 +11,17 @@     p_qualName,     p_infixDefHelper,     p_hsDocString,-    p_hsDocName,   ) where  import Control.Monad-import Data.List (isPrefixOf)+import Data.Functor+import Data.List (intersperse, isPrefixOf) import qualified Data.Text as T import GHC hiding (GhcPs, IE) import Name (nameStableString) import OccName (OccName (..))+import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Utils @@ -114,35 +115,35 @@ 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' =             if null ps               then id-              else parens N+              else parens N . sitcc       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 ::@@ -161,16 +162,35 @@   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-    if isFirst-      then case hstyle of-        Pipe -> txt "-- |"-        Caret -> txt "-- ^"-        Asterisk n -> txt ("-- " <> T.replicate n "*")-        Named name -> p_hsDocName name-      else newline >> txt "--"-    space-    unless (T.null x) (txt x)+  let txt' x = unless (T.null x) (txt x)+      docLines = splitDocString str+      body s = do+        txt $ case hstyle of+          Pipe -> " |"+          Caret -> " ^"+          Asterisk n -> " " <> T.replicate n "*"+          Named name -> " $" <> T.pack name+        sequence_ $ intersperse (newline >> s) $ map txt' docLines+  single <-+    getPrinterOpt poHaddockStyle <&> \case+      HaddockSingleLine -> True+      -- Use multiple single-line comments when the whole comment is indented+      HaddockMultiLine -> maybe False ((> 1) . srcSpanStartCol) $ unSrcSpan l+  if single+    then do+      txt "--"+      body $ txt "--"+    else+      if length docLines <= 1+        then do+          txt "--"+          body $ pure ()+        else do+          txt "{-"+          body $ pure ()+          newline+          txt "-}"+   when needsNewline newline   case l of     UnhelpfulSpan _ ->@@ -179,7 +199,3 @@       -- nearest enclosing span.       getEnclosingSpan (const True) >>= mapM_ (setSpanMark . HaddockSpan hstyle)     RealSrcSpan spn -> setSpanMark (HaddockSpan hstyle spn)---- | Print anchor of named doc section.-p_hsDocName :: String -> R ()-p_hsDocName name = txt ("-- $" <> T.pack name)
src/Ormolu/Printer/Meat/Declaration.hs view
@@ -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 =@@ -84,9 +85,6 @@     isHaddock _ = False  -- | Group relevant declarations together.------ Add a declaration to a group iff it is relevant to either the first or--- the preceding declaration in the group. groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)] groupDecls [] = [] groupDecls (l@(L _ DocNext) : xs) =@@ -99,7 +97,8 @@   let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->         let relevantToHdr = groupedDecls header current             relevantToPrev = groupedDecls previous current-         in relevantToHdr || relevantToPrev+            isDeclSeries = declSeries previous current+         in isDeclSeries || relevantToHdr || relevantToPrev    in (header :| map snd grp) : groupDecls (map snd rest)  p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()@@ -196,6 +195,18 @@     (_, DocPrev) -> True     _ -> False +-- | Detect declaration series that should not have blanks between them.+declSeries ::+  LHsDecl GhcPs ->+  LHsDecl GhcPs ->+  Bool+declSeries (L _ x) (L _ y) =+  case (x, y) of+    ( SigD NoExtField (TypeSig NoExtField _ _),+      SigD NoExtField (TypeSig NoExtField _ _)+      ) -> True+    _ -> False+ intersects :: Ord a => [a] -> [a] -> Bool intersects a b = go (sort a) (sort b)   where@@ -288,9 +299,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]
src/Ormolu/Printer/Meat/Declaration.hs-boot view
@@ -9,5 +9,4 @@ import Ormolu.Printer.Meat.Common  p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()- p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
src/Ormolu/Printer/Meat/Declaration/Class.hs view
@@ -14,6 +14,7 @@ import Data.Foldable import Data.List (sortOn) import GHC+import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration@@ -58,7 +59,7 @@       switchLayout signatureSpans $         p_infixDefHelper           (isInfix fixity)-          inci+          True           (p_rdrName name)           (located' p_hsTyVarBndr <$> hsq_explicit)       inci (p_classFundeps fdeps)@@ -82,7 +83,12 @@   breakpoint   txt "|"   space-  sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps+  inci' $ sep commaDel (sitcc . located' p_funDep) fdeps+  where+    inci' x =+      getPrinterOpt poCommaStyle >>= \case+        Leading -> id x+        Trailing -> inci x  p_funDep :: FunDep (Located RdrName) -> R () p_funDep (before, after) = do
src/Ormolu/Printer/Meat/Declaration/Data.hs view
@@ -10,7 +10,9 @@  import Control.Monad import Data.Maybe (isJust, maybeToList)+import qualified Data.Text as Text import GHC+import Ormolu.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type@@ -41,7 +43,7 @@     inci $       p_infixDefHelper         (isInfix fixity)-        inci+        True         (p_rdrName name)         (located' p_hsType <$> tpats)   case dd_kindSig of@@ -60,28 +62,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 +106,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)@@ -149,6 +148,8 @@       when (unLoc con_forall) $ do         p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs         breakpoint+        indent <- getPrinterOpt poIndentation+        vlayout (pure ()) . txt $ Text.replicate (indent - 2) " "       forM_ con_mb_cxt p_lhsContext       switchLayout conDeclSpn $ case con_args of         PrefixCon xs -> do@@ -158,11 +159,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 +208,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
src/Ormolu/Printer/Meat/Declaration/Default.hs view
@@ -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
src/Ormolu/Printer/Meat/Declaration/Instance.hs view
@@ -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 
src/Ormolu/Printer/Meat/Declaration/Rule.hs view
@@ -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 @@ -55,7 +55,7 @@ p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case   RuleBndr NoExtField x -> p_rdrName x-  RuleBndrSig NoExtField x hswc -> parens N $ do+  RuleBndrSig NoExtField x hswc -> parens N . sitcc $ do     p_rdrName x     p_typeAscription hswc   XRuleBndr x -> noExtCon x
src/Ormolu/Printer/Meat/Declaration/Signature.hs view
@@ -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
src/Ormolu/Printer/Meat/Declaration/Type.hs view
@@ -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
src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs view
@@ -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
src/Ormolu/Printer/Meat/Declaration/Value.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-}@@ -22,12 +23,13 @@ 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.Config import Ormolu.Printer.Combinators import Ormolu.Printer.Internal import Ormolu.Printer.Meat.Common@@ -61,7 +63,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@@ -180,25 +182,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@@ -213,7 +214,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@@ -225,7 +226,7 @@         Case -> True         LambdaCase -> True         _ -> False-  let hasGuards = withGuards grhssGRHSs+      hasGuards = withGuards grhssGRHSs       grhssSpan =         combineSrcSpans' $           getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs@@ -251,10 +252,11 @@         let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)         unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do           breakpoint-          txt "where"+          indentWhere <- getPrinterOpt poIndentWheres+          bool (inciBy $ -2) id indentWhere $ txt "where"           unless whereIsEmpty breakpoint-          inci $ located grhssLocalBinds p_hsLocalBinds-  inci' $ do+          inciIf indentWhere $ located grhssLocalBinds p_hsLocalBinds+  inciIf indentBody $ do     unless (length grhssGRHSs > 1) $       case style of         Function _ | hasGuards -> return ()@@ -285,7 +287,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@@ -317,7 +319,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@@ -334,7 +336,7 @@     -- does. Open an issue and ping @yumiova if this ever occurs in output.     notImplemented "HsCmdApp"   HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup-  HsCmdPar NoExtField c -> parens N (located c p_hsCmd)+  HsCmdPar NoExtField c -> parens N $ sitcc $ located c p_hsCmd   HsCmdCase NoExtField e mgroup ->     p_case cmdPlacement p_hsCmd e mgroup   HsCmdIf NoExtField _ if' then' else' ->@@ -354,7 +356,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@@ -465,30 +474,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.@@ -521,12 +524,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 @@ -590,23 +587,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@@ -621,16 +616,21 @@     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     located e p_hsExpr-  HsPar NoExtField e ->-    parens s (located e (dontUseBraces . p_hsExpr))+  HsPar NoExtField e -> do+    parens s $ sitcc $ located e $ dontUseBraces . p_hsExpr   SectionL NoExtField x op -> do     located x p_hsExpr     breakpoint@@ -641,22 +641,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_hsExprListItem+          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 ->@@ -666,7 +671,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@@ -678,16 +683,20 @@             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+                sitcc'                   . sep-                    (comma >> breakpoint)+                    commaDel                     (located' (sitcc . p_stmt))+              sitcc' x =+                getPrinterOpt poCommaStyle >>= \case+                  Leading -> id x+                  Trailing -> sitcc x               stmts = init xs               yield = last xs               lists = foldr (liftAppend . gatherStmt) [] stmts@@ -707,11 +716,11 @@       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_hsExprListItem) xs   RecordCon {..} -> do     located rcon_con_name atom-    breakpoint+    breakpointPreRecordBrace     let HsRecFields {..} = rcon_flds         updName f =           (f :: HsRecField GhcPs (LHsExpr GhcPs))@@ -724,8 +733,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@@ -735,7 +744,7 @@     let isPluginForm =           ((1 +) . srcSpanEndCol <$> mrs rupd_expr)             == (srcSpanStartCol <$> mrs (head rupd_flds))-    unless (useRecordDot' && isPluginForm) breakpoint+    unless (useRecordDot' && isPluginForm) breakpointPreRecordBrace     let updName f =           (f :: HsRecUpdField GhcPs)             { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of@@ -743,9 +752,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@@ -758,22 +767,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@@ -830,9 +839,9 @@             txt "<-"             breakpoint             located psb_def p_pat-            newline+            breakpoint             txt "where"-            newline+            breakpoint             inci (p_matchGroup (Function psb_id) mgroup)   txt "pattern"   case psb_args of@@ -849,9 +858,9 @@       p_rdrName psb_id       inci $ do         switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do-          unless (null xs) breakpoint-          braces N . sitcc $-            sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs+          unless (null xs) breakpointPreRecordBrace+          braces N $+            sep commaDel (p_rdrName . recordPatSynPatVar) xs         rhs     InfixCon l r -> do       switchLayout [getLoc l, getLoc r] $ do@@ -942,18 +951,18 @@     txt "@"     located pat p_pat   ParPat NoExtField pat ->-    located pat (parens S . p_pat)+    located pat (parens S . sitcc . p_pat)   BangPat NoExtField pat -> do     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 ->@@ -965,11 +974,11 @@           inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs       RecCon (HsRecFields fields dotdot) -> do         p_rdrName pat-        breakpoint+        breakpointPreRecordBrace         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]@@ -1019,17 +1028,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@@ -1231,11 +1238,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@@ -1261,15 +1267,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.@@ -1291,51 +1298,61 @@         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-          let opAndRhs = do-                p_op-                space-                p_y-          case x of-            -- This case prevents an operator from being indented past the start of a `do` block-            -- constituting its left operand, thus altering the AST.-            -- This is only relevant when the `do` block is on one line, as otherwise we will-            -- insert a newline after `do` anyway.-            OpNode (unLoc -> HsDo _ _ _) | isOneLineSpan (opTreeLoc x) -> breakpoint >> opAndRhs-            _ -> placeHanging placement opAndRhs+  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+        let opAndRhs = do+              p_op+              space+              p_y+        case x of+          -- This case prevents an operator from being indented past the start of a `do` block+          -- constituting its left operand, thus altering the AST.+          -- This is only relevant when the `do` block is on one line, as otherwise we will+          -- insert a newline after `do` anyway.+          OpNode (unLoc -> HsDo _ _ _) | isOneLineSpan (opTreeLoc x) -> breakpoint >> opAndRhs+          _ -> placeHanging placement opAndRhs  -- | Return 'True' if given expression is a record-dot operator expression. isRecordDot ::@@ -1346,14 +1363,10 @@   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] getEnclosingAnns = do@@ -1361,3 +1374,29 @@   case e of     Nothing -> return []     Just e' -> getAnns (RealSrcSpan e')++-- | For use before record braces. Collapse to empty if not 'poRecordBraceSpace'.+breakpointPreRecordBrace :: R ()+breakpointPreRecordBrace = do+  useSpace <- getPrinterOpt poRecordBraceSpace+  if useSpace+    then breakpoint+    else breakpoint'++-- | For nested lists/tuples, pad with whitespace so that we always indent correctly,+-- rather than sometimes indenting by 2 regardless of 'poIndentation'.+p_hsExprListItem :: HsExpr GhcPs -> R ()+p_hsExprListItem e = do+  indent <- getPrinterOpt poIndentation+  when (listLike e) $ do+    getPrinterOpt poCommaStyle >>= \case+      Leading -> breakpoint'+      Trailing -> pure ()+    vlayout (pure ()) (spaces $ indent - 2)+  p_hsExpr e+  where+    spaces n = txt $ Text.replicate n " "+    listLike = \case+      ExplicitList {} -> True+      ExplicitTuple {} -> True+      _ -> False
src/Ormolu/Printer/Meat/Declaration/Value.hs-boot view
@@ -11,11 +11,7 @@ import Ormolu.Printer.Combinators  p_valDecl :: HsBindLR GhcPs GhcPs -> R ()- p_pat :: Pat GhcPs -> R ()- p_hsExpr :: HsExpr GhcPs -> R ()- p_hsSplice :: HsSplice GhcPs -> R ()- p_stringLit :: String -> R ()
src/Ormolu/Printer/Meat/Declaration/Warning.hs view
@@ -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
src/Ormolu/Printer/Meat/ImportExport.hs view
@@ -6,11 +6,14 @@ module Ormolu.Printer.Meat.ImportExport   ( p_hsmodExports,     p_hsmodImport,+    breakIfNotDiffFriendly,   ) where  import Control.Monad+import qualified Data.Text as T import GHC+import Ormolu.Config (poDiffFriendlyImportExport) import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Utils (RelativePos (..), attachRelativePos)@@ -21,7 +24,7 @@   breakpoint'   txt ")" p_hsmodExports xs =-  parens N . sitcc $ do+  parens' False $ do     layout <- getLayout     sep       breakpoint@@ -64,8 +67,8 @@     case ideclHiding of       Nothing -> return ()       Just (_, L _ xs) -> do-        breakpoint-        parens N . sitcc $ do+        breakIfNotDiffFriendly+        parens' True $ do           layout <- getLayout           sep             breakpoint@@ -89,13 +92,12 @@     p_comma   IEThingWith NoExtField l1 w xs _ -> sitcc $ do     located l1 p_ieWrappedName-    breakpoint+    breakIfNotDiffFriendly     inci $ do       let names :: [R ()]           names = located' p_ieWrappedName <$> xs-      parens N . sitcc-        $ sep (comma >> breakpoint) sitcc-        $ case w of+      parens' False . sep commaDel' sitcc $+        case w of           NoIEWildcard -> names           IEWildcard n ->             let (before, after) = splitAt n names@@ -113,7 +115,7 @@     p_hsDocString (Asterisk n) False (noLoc str)   IEDoc NoExtField str ->     p_hsDocString Pipe False (noLoc str)-  IEDocNamed NoExtField str -> p_hsDocName str+  IEDocNamed NoExtField str -> txt $ "-- $" <> T.pack str   XIE x -> noExtCon x   where     p_comma =@@ -125,3 +127,40 @@             MiddlePos -> comma             LastPos -> return ()         MultiLine -> comma++----------------------------------------------------------------------------+-- Unlike the versions in 'Ormolu.Printer.Combinators', these do not depend on+-- whether 'leadingCommas' is set. This is useful here is we choose to keep+-- import and export lists independent of that setting.++-- | Delimiting combination with 'comma'. To be used with 'sep'.+commaDel' :: R ()+commaDel' = comma >> breakpoint++-- | Surround given entity by parentheses @(@ and @)@.+parens' :: Bool -> R () -> R ()+parens' topLevelImport m =+  getPrinterOpt poDiffFriendlyImportExport >>= \case+    True -> do+      txt "("+      breakpoint'+      sitcc body+      vlayout (txt ")") (inciBy (-1) trailingParen)+    False -> sitcc $ do+      txt "("+      body+      txt ")"+  where+    body = vlayout singleLine multiLine+    singleLine = m+    multiLine = do+      space+      sitcc m+      newline+    trailingParen = if topLevelImport then txt " )" else txt ")"++breakIfNotDiffFriendly :: R ()+breakIfNotDiffFriendly =+  getPrinterOpt poDiffFriendlyImportExport >>= \case+    True -> space+    False -> breakpoint
src/Ormolu/Printer/Meat/Module.hs view
@@ -11,7 +11,8 @@ import Control.Monad import qualified Data.Text as T import GHC-import Ormolu.Imports+import Ormolu.Config+import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang@@ -56,22 +57,31 @@         located hsmodName' $ \name -> do           forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)           p_hsmodName name-        breakpoint         forM_ hsmodDeprecMessage $ \w -> do-          located' p_moduleWarning w           breakpoint+          located' p_moduleWarning w+        breakIfNotDiffFriendly++        -- This works around an awkward idempotency bug with deprecation messages.+        diffFriendly <- getPrinterOpt poDiffFriendlyImportExport+        when (diffFriendly && not (null hsmodDeprecMessage)) newline+         case hsmodExports of           Nothing -> return ()           Just l -> do             located l $ \exports -> do               inci (p_hsmodExports exports)-            breakpoint+            breakIfNotDiffFriendly         txt "where"         newline     newline-    forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))+    preserveGroups <- getPrinterOpt poRespectful+    forM_ (normalizeImports preserveGroups hsmodImports) $ \importGroup -> do+      forM_ importGroup (located' (p_hsmodImport qualifiedPost))+      newline     newline     switchLayout (getLoc <$> hsmodDecls) $ do-      p_hsDecls Free hsmodDecls+      preserveSpacing <- getPrinterOpt poRespectful+      (if preserveSpacing then p_hsDeclsRespectGrouping else p_hsDecls) Free hsmodDecls       newline       spitRemainingComments
src/Ormolu/Printer/Meat/Type.hs view
@@ -52,6 +52,7 @@   HsTyVar NoExtField p n -> do     case p of       IsPromoted -> do+        space         txt "'"         case showOutputable (unLoc n) of           _ : '\'' : _ -> space@@ -67,7 +68,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,17 +99,16 @@             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 $       let opTree = OpBranch (tyOpTree x) op (tyOpTree y)        in p_tyOpTree (reassociateOpTree Just opTree)   HsParTy NoExtField t ->-    parens N (located t p_hsType)+    parens N $ sitcc $ located t p_hsType   HsIParamTy NoExtField n t -> sitcc $ do     located n atom     space@@ -118,9 +118,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 +154,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,15 +192,13 @@ 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   UserTyVar NoExtField x ->     p_rdrName x-  KindedTyVar NoExtField l k -> parens N $ do+  KindedTyVar NoExtField l k -> parens N . sitcc $ do     located l atom     space     txt "::"@@ -224,15 +222,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 +271,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
src/Ormolu/Printer/Operators.hs view
@@ -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
src/Ormolu/Processing/Common.hs view
@@ -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
src/Ormolu/Processing/Postprocess.hs view
@@ -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
src/Ormolu/Processing/Preprocess.hs view
@@ -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)@@ -128,11 +127,11 @@  -- | Return 'True' if the given string is an enabling marker. isOrmoluEnable :: String -> Bool-isOrmoluEnable = magicComment "ORMOLU_ENABLE"+isOrmoluEnable s = magicComment "ORMOLU_ENABLE" s || magicComment "FOURMOLU_ENABLE" s  -- | Return 'True' if the given string is a disabling marker. isOrmoluDisable :: String -> Bool-isOrmoluDisable = magicComment "ORMOLU_DISABLE"+isOrmoluDisable s = magicComment "ORMOLU_DISABLE" s || magicComment "FOURMOLU_DISABLE" s  -- | Construct a function for whitespace-insensitive matching of string. magicComment ::@@ -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)
src/Ormolu/Utils.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns #-}  -- | Random utilities used by the code. module Ormolu.Utils@@ -15,12 +16,15 @@     separatedByBlank,     separatedByBlankNE,     onTheSameLine,+    removeIndentation,+    groupBy',   ) 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@@ -68,8 +72,7 @@     _ -> r   where     r =-      fmap escapeLeadingDollar-        . dropPaddingSpace+      fmap (escapeLeadingDollar . escapeCommentBraces)         . dropWhileEnd T.null         . fmap (T.stripEnd . T.pack)         . lines@@ -81,20 +84,7 @@       case T.uncons txt of         Just ('$', _) -> T.cons '\\' txt         _ -> txt-    dropPaddingSpace xs =-      case dropWhile T.null xs of-        [] -> []-        (x : _) ->-          let leadingSpace txt = case T.uncons txt of-                Just (' ', _) -> True-                _ -> False-              dropSpace txt =-                if leadingSpace txt-                  then T.drop 1 txt-                  else txt-           in if leadingSpace x-                then dropSpace <$> xs-                else xs+    escapeCommentBraces = T.replace "{-" "{\\-" . T.replace "-}" "-\\}"  -- | Get 'LHsType' out of 'LHsTypeArg'. typeArgToType :: LHsTypeArg p -> LHsType p@@ -139,3 +129,24 @@ 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)++-- | A generalisation of 'groupBy' to functions which aren't equivalences - a group ends+-- when comparison fails with the previous element, rather than the first of the group.+groupBy' :: (a -> a -> Bool) -> [a] -> [NonEmpty a]+groupBy' eq = flip foldr [] $ \x -> \case+  [] -> [pure x]+  (y :| ys) : zs ->+    if x `eq` y+      then (x :| y : ys) : zs+      else pure x : (y :| ys) : zs
tests/Ormolu/PrinterSpec.hs view
@@ -10,6 +10,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import Ormolu+import Ormolu.Config import Path import Path.IO import qualified System.FilePath as F@@ -18,14 +19,24 @@ spec :: Spec spec = do   es <- runIO locateExamples-  forM_ es checkExample+  let ormoluOpts =+        PrinterOpts+          { poIndentation = pure 2,+            poCommaStyle = pure Trailing,+            poIndentWheres = pure True,+            poRecordBraceSpace = pure True,+            poDiffFriendlyImportExport = pure False,+            poRespectful = pure False,+            poHaddockStyle = pure HaddockSingleLine+          }+  sequence_ $ uncurry checkExample <$> [(ormoluOpts, ""), (defaultPrinterOpts, "-four")] <*> es  -- | Check a single given example.-checkExample :: Path Rel File -> Spec-checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do+checkExample :: PrinterOptsTotal -> String -> Path Rel File -> Spec+checkExample po suffix srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do   let srcPath = examplesDir </> srcPath'-      cfg = defaultConfig {cfgPrinterOpts = PrinterOpts {poIndentStep = 2}}-  expectedOutputPath <- deriveOutput srcPath+      cfg = defaultConfig {cfgPrinterOpts = po}+  expectedOutputPath <- deriveOutput suffix srcPath   -- 1. Given input snippet of source code parse it and pretty print it.   -- 2. Parse the result of pretty-printing again and make sure that AST   -- is the same as AST of the original snippet. (This happens in@@ -55,10 +66,10 @@    in exts == ".hs" && not ("-out" `isSuffixOf` s')  -- | For given path of input file return expected name of output.-deriveOutput :: Path Rel File -> IO (Path Rel File)-deriveOutput path =+deriveOutput :: String -> Path Rel File -> IO (Path Rel File)+deriveOutput suffix path =   parseRelFile $-    F.addExtension (F.dropExtensions (fromRelFile path) ++ "-out") "hs"+    F.addExtension (F.dropExtensions (fromRelFile path) ++ suffix ++ "-out") "hs"  -- | A version of 'shouldBe' that is specialized to comparing 'Text' values. -- It also prints multi-line snippets in a more readable form.