packages feed

fourmolu (empty) → 0.0.6.0

raw patch · 719 files changed

+15352/−0 lines, 719 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, dlist, exceptions, filepath, fourmolu, ghc-lib-parser, gitrev, hspec, mtl, optparse-applicative, path, path-io, syb, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,179 @@+## Fourmolu 0.0.6.0++* The project was fourked to provide four space indent.++* Fixed rendering of type signatures concerning several identifiers. [Issue+  566](https://github.com/tweag/ormolu/issues/566).++* Fixed an idempotence issue with inline comments in tuples and parentheses.+  [Issue 450](https://github.com/tweag/ormolu/issues/450).++* Fixed an idempotence issue when certain comments where picked up as+  “continuation” of a series of comments [Issue+  449](https://github.com/tweag/ormolu/issues/449).++* Fixed an idempotence issue related to different indentation levels in a+  comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512).++* Fixed an idempotence issue related to comments which may happen to be+  separated from the elements they are attached to by the equality sign.+  [Issue 340](https://github.com/tweag/ormolu/issues/340).++* Fixed an idempotence issue with type synonym and data declarations where+  the type has a Haddock. [Issue+  578](https://github.com/tweag/ormolu/issues/578).++* Fix the false positive about AST differences in presence of comments with+  multiple blank lines in a row. [Issue+  518](https://github.com/tweag/ormolu/issues/518).++* Fixed rendering of comment around if expressions. [Issue+  458](https://github.com/tweag/ormolu/issues/458).++* Unnamed fields of data constructors are now documented using the `-- ^`+  syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue+  428](https://github.com/tweag/ormolu/issues/428).++* Fixed non-idempotent transformation of partly documented data definition.+  [Issue 590](https://github.com/tweag/ormolu/issues/590).++* Renamed the `--check-idempotency` flag to `--check-idempotence`.+  Apparently only the latter is correct.++## Ormolu 0.0.5.0++* Grouping of statements in `do`-blocks is now preserved. [Issue+  74](https://github.com/tweag/ormolu/issues/74).++* Grouping of TH splices is now preserved. [Issue+  507](https://github.com/tweag/ormolu/issues/507).++* Comments on pragmas are now preserved. [Issue+  216](https://github.com/tweag/ormolu/issues/216).++* Ormolu can now be enabled and disabled via special comments. [Issue+  435](https://github.com/tweag/ormolu/issues/435).++* Added experimental support for simple CPP. [Issue+  415](https://github.com/tweag/ormolu/issues/415).++* Added two new options `--start-line` and `--end-line` that allow us to+  select a region to format. [Issue+  516](https://github.com/tweag/ormolu/issues/516).++* Fixed rendering of module headers in the presence of preceding comments or+  Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561).++## Ormolu 0.0.4.0++* When given several files to format, Ormolu does not stop on the first+  failure, but tries to format all the files. [Issue+  502](https://github.com/tweag/ormolu/issues/502).++* Made rendering of pattern matches involving operators consistent with+  other cases of rendering of operators. [Issue+  500](https://github.com/tweag/ormolu/issues/500).++* More compact rendering of type family injectivity constraints. [Issue+  482](https://github.com/tweag/ormolu/issues/482).++* Improved rendering of the keyword `where` in class, data, and type family+  declarations. When headers of these declarations are multi-line `where` is+  now put on its own line. [Issue+  509](https://github.com/tweag/ormolu/issues/509).++* Fixed the bug pertaining to rendering of arrow notation with multiline+  expressions. [Issue 513](https://github.com/tweag/ormolu/issues/513).++* Made rendering of data type definitions, value-level applications, and+  application of types use the same style. Moreover, existential now doesn't+  cause the data constructor be unconditionally rendered in multiline+  layout. [Issue 427](https://github.com/tweag/ormolu/issues/427).++* Records with a single data constructor are now formatted more compactly.+  [Issue 425](https://github.com/tweag/ormolu/issues/425).++* Switched to `ghc-lib-parser-8.10.1`.++* Implemented support for the new language extensions `ImportQualifiedPost`+  and `StandaloneKindSignatures`.++## Ormolu 0.0.3.1++* Fixed rendering of record updates with the record dot preprocessor syntax+  [Issue 498](https://github.com/tweag/ormolu/issues/498).++## Ormolu 0.0.3.0++* Fixed an issue related to unnecessary use of curly braces. [Issue+  473](https://github.com/tweag/ormolu/issues/473).++* Fixed the issue with formatting multi-way if when it happens to be a+  function applied to arguments [Issue+  488](https://github.com/tweag/ormolu/issues/488). This changed the way+  multi-line if is formatted in general.++* Added support for record dot pre-processor when used via the plugin.+  [Issue 486](https://github.com/tweag/ormolu/issues/486).++* Stopped hanging record constructors and improved placing+  potentially-hanging consturctions in the presence of comments. [Issue+  447](https://github.com/tweag/ormolu/issues/447).++* Fixed indentation in presence of type applications. [Issue+  493](https://github.com/tweag/ormolu/issues/493).++* Class and instance declarations now do not have a blank line after+  `where`. Grouping of methods from the original input is also preserved+  with some normalizations. [Issue+  431](https://github.com/tweag/ormolu/issues/431).++## Ormolu 0.0.2.0++* Switched to `ghc-lib-parser` instead of depending on the `ghc` package+  directly. This should allow us to use newest features of GHC while not+  necessarily depending on the newest version of the compiler. In addition+  to that Ormolu is now GHCJS-compatible.++* Now unrecognized GHC options passed with `--ghc-opt` cause Ormolu to fail+  (exit code 7).++* Fixed formatting of result type in closed type families. See [issue+  420](https://github.com/tweag/ormolu/issues/420).++* Fixed a minor inconsistency between formatting of normal and foreign type+  signatures. See [issue 408](https://github.com/tweag/ormolu/issues/408).++* Fixed a bug when comment before module header with Haddock was moved+  inside the export list. See [issue+  430](https://github.com/tweag/ormolu/issues/430).++* Empty `forall`s are now correctly preserved. See [issue+  429](https://github.com/tweag/ormolu/issues/429).++* Fixed [issue 446](https://github.com/tweag/ormolu/issues/446), which+  involved braces and operators.++* When there are comments between preceding Haddock (pipe-style) and its+  corresponding declaration they are preserved like this in the output+  instead of being shifted. To be clear, this is not a very good idea to+  have comments in that position because the Haddock will end up not being+  associated with the declarations. Issues+  [440](https://github.com/tweag/ormolu/issues/440) and+  [448](https://github.com/tweag/ormolu/issues/448).++* Implemented correct handling of shebangs. [Issue+  377](https://github.com/tweag/ormolu/issues/377).++* Implemented correct handling of stack headers. [Issue+  393](https://github.com/tweag/ormolu/issues/393).++* Sorting language pragmas cannot not change meaning of the input program+  anymore. [Issue 404](https://github.com/tweag/ormolu/issues/404).++* Fixed formatting of applications where function is a complex expression.+  [Issue 444](https://github.com/tweag/ormolu/issues/444).++## Ormolu 0.0.1.0++* Initial release.
+ CONTRIBUTING.md view
@@ -0,0 +1,64 @@+# 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 view
@@ -0,0 +1,407 @@+# 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
+ LICENSE.md view
@@ -0,0 +1,28 @@+Copyright © 2018–2020 Tweag I/O, 2020-present Matt Parsons++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice,+  this list of conditions and the following disclaimer.++* Redistributions in binary form must reproduce the above copyright+  notice, this list of conditions and the following disclaimer in the+  documentation and/or other materials provided with the distribution.++* Neither the name Tweag I/O nor the names of contributors may be used to+  endorse or promote products derived from this software without specific+  prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS+OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES+OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN+NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT,+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA,+OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,+EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,171 @@+# ~~Ormolu~~ 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)++~~Ormolu~~ Fourmolu is a formatter for Haskell source code. The project was created with+the following goals in mind:++* Using GHC's own parser to avoid parsing problems caused by+  [`haskell-src-exts`][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+  the user, not by an algorithm. This makes the implementation simpler and+  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.+* 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:++```console+$ nix-build -A ormolu+```++Or with `cabal-install` from the Nix shell:++```console+$ nix-shell --run "cabal new-build"+```++Alternatively, `stack` could be used with a `stack.yaml` file as follows.++```console+$ cat stack.yaml+resolver: lts-14.3+packages:+- '.'++$ stack build+```++To use Ormolu directly from GitHub with Nix, this snippet may come in handy:++```nix+# This overlay adds Ormolu straight from GitHub.+self: super:++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;+      };+    };+  };+}+```++## Usage++The following will print the formatted output to the standard output.++```console+$ ormolu Module.hs+```++Add `--mode inplace` to replace the contents of the input file with the+formatted output.++```console+$ ormolu --mode inplace Module.hs+```++Use `find` to format a tree recursively:++```console+$ ormolu --mode inplace $(find . -name '*.hs')+```++## Magic comments++Ormolu understands two magic comments:++```haskell+{- ORMOLU_DISABLE -}+```++and++```haskell+{- ORMOLU_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.++## 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+  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).++## Contributing++See [CONTRIBUTING.md][contributing].++## License++See [LICENSE.md][license].++Copyright © 2018–present Tweag I/O++[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
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++module Main (main) where++import Control.Exception (SomeException, displayException, try)+import Control.Monad+import Data.Either (lefts)+import Data.List (intercalate, sort)+import qualified Data.Text.IO as TIO+import Data.Version (showVersion)+import Development.GitRev+import Options.Applicative+import Ormolu+import Ormolu.Parser (manualExts)+import Ormolu.Utils (showOutputable)+import Paths_fourmolu (version)+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' = formatOne optMode optConfig+  case optInputFiles of+    [] -> formatOne' Nothing+    ["-"] -> formatOne' Nothing+    [x] -> formatOne' (Just x)+    xs -> do+      -- 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)+      unless (null errs) $ do+        mapM_ (hPutStrLn stderr . displayException) errs+        exitWith (ExitFailure 102)++-- | Format a single input.+formatOne ::+  -- | Mode of operation+  Mode ->+  -- | Configuration+  Config RegionIndices ->+  -- | File to format or stdin as 'Nothing'+  Maybe FilePath ->+  IO ()+formatOne mode config = \case+  Nothing -> do+    r <- ormoluStdin config+    case mode of+      Stdout -> TIO.putStr r+      _ -> do+        hPutStrLn+          stderr+          "This feature is not supported when input comes from stdin."+        -- 101 is different from all the other exit codes we already use.+        exitWith (ExitFailure 101)+  Just inputFile -> do+    r <- ormoluFile config inputFile+    case mode of+      Stdout ->+        TIO.putStr r+      InPlace ->+        TIO.writeFile inputFile r+      Check -> do+        r' <- TIO.readFile inputFile+        when (r /= r') $+          -- 100 is different to all the other exit code that are emitted+          -- either from an 'OrmoluException' or from 'error' and+          -- 'notImplemented'.+          exitWith (ExitFailure 100)++----------------------------------------------------------------------------+-- Command line options parsing.++data Opts = Opts+  { -- | Mode of operation+    optMode :: !Mode,+    -- | Ormolu 'Config'+    optConfig :: !(Config RegionIndices),+    -- | Haskell source files to format or stdin (when the list is empty)+    optInputFiles :: ![FilePath]+  }++-- | Mode of operation.+data Mode+  = -- | Output formatted source code to stdout+    Stdout+  | -- | Overwrite original file+    InPlace+  | -- | Exit with non-zero status code if+    -- source is not already formatted+    Check+  deriving (Eq, Show)++optsParserInfo :: ParserInfo Opts+optsParserInfo =+  info (helper <*> ver <*> exts <*> optsParser) . mconcat $+    [ fullDesc,+      progDesc "",+      header ""+    ]+  where+    ver :: Parser (a -> a)+    ver =+      infoOption verStr . mconcat $+        [ long "version",+          short 'v',+          help "Print version of the program"+        ]+    verStr =+      intercalate+        "\n"+        [ unwords+            [ "ormolu",+              showVersion version,+              $gitBranch,+              $gitHash+            ],+          "using ghc-lib-parser " ++ VERSION_ghc_lib_parser+        ]+    exts :: Parser (a -> a)+    exts =+      infoOption displayExts . mconcat $+        [ long "manual-exts",+          help "Display extensions that need to be enabled manually"+        ]+    displayExts = unlines $ sort (showOutputable <$> manualExts)++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'"+      ]+    <*> configParser+    <*> (many . strArgument . mconcat)+      [ metavar "FILE",+        help "Haskell source files to format or stdin (default)"+      ]++configParser :: Parser (Config RegionIndices)+configParser =+  Config+    <$> (fmap (fmap DynOption) . many . strOption . mconcat)+      [ long "ghc-opt",+        short 'o',+        metavar "OPT",+        help "GHC options to enable (e.g. language extensions)"+      ]+    <*> (switch . mconcat)+      [ long "unsafe",+        short 'u',+        help "Do formatting faster but without automatic detection of defects"+      ]+    <*> (switch . mconcat)+      [ long "debug",+        short 'd',+        help "Output information useful for debugging"+      ]+    <*> (switch . mconcat)+      [ long "check-idempotence",+        short 'c',+        help "Fail if formatting is not idempotent"+      ]+    <*> ( RegionIndices+            <$> (optional . option auto . mconcat)+              [ long "start-line",+                metavar "START",+                help "Start line of the region to format (starts from 1)"+              ]+            <*> (optional . option auto . mconcat)+              [ long "end-line",+                metavar "END",+                help "End line of the region to format (inclusive)"+              ]+        )++----------------------------------------------------------------------------+-- Helpers++-- | Parse 'Mode'.+parseMode :: ReadM Mode+parseMode = eitherReader $ \case+  "stdout" -> Right Stdout+  "inplace" -> Right InPlace+  "check" -> Right Check+  s -> Left $ "unknown mode: " ++ s
+ data/examples/declaration/annotation/annotation-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/annotation/annotation.hs view
@@ -0,0 +1,20 @@+{-#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-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-data1.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TypeFamilies #-}++class Foo a where data FooBar a++-- | Something.+class Bar a+  where+    -- | Bar bar+    data BarBar a+    -- | Bar baz+    data family BarBaz+        a
+ data/examples/declaration/class/associated-data2-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-data2.hs view
@@ -0,0 +1,17 @@+module Main where++{-# LANGUAGE TypeFamilies #-}++-- | Something more.+class Baz a where+    -- | Baz bar+    data BazBar+        a+        b+        c++    -- | Baz baz+    data family BazBaz+        b+        a+        c
+ data/examples/declaration/class/associated-type-defaults-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-type-defaults.hs view
@@ -0,0 +1,20 @@+{-# 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-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-types1.hs view
@@ -0,0 +1,12 @@+{-# 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-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/associated-types2.hs view
@@ -0,0 +1,18 @@+module Main where++{-# LANGUAGE TypeFamilies #-}++-- | 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-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-comments.hs view
@@ -0,0 +1,22 @@+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-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-implementations.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-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-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/default-signatures-simple.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/default-signatures.hs view
@@ -0,0 +1,26 @@+module Main where++{-# LANGUAGE DefaultSignatures #-}++-- | 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/dependency-super-classes-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/dependency-super-classes.hs view
@@ -0,0 +1,24 @@+module Main where++{-# LANGUAGE FunctionalDependencies #-}++-- | 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-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Foo!+class Foo a++-- | Bar!+class Bar a
+ data/examples/declaration/class/empty-classes.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Foo!+class Foo a where+-- | Bar!+class Bar a
+ data/examples/declaration/class/functional-dependencies-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/functional-dependencies.hs view
@@ -0,0 +1,18 @@+module Main where++{-# LANGUAGE FunctionalDependencies #-}++-- | 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-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-parameters1.hs view
@@ -0,0 +1,18 @@+{-# 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-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/multi-parameters2.hs view
@@ -0,0 +1,18 @@+module Main where++{-# LANGUAGE MultiParamTypeClasses #-}++-- | 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-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-after-where.hs view
@@ -0,0 +1,7 @@+class Num a where+  (+) :: a -> a -> a++class Num a where+++  (+) :: a -> a -> a
+ data/examples/declaration/class/newlines-and-default-decls-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-default-decls.hs view
@@ -0,0 +1,13 @@+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-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-and-haddocks.hs view
@@ -0,0 +1,19 @@+class Foo a where+  -- | Haddock+  foo :: a+  -- | Another Haddock+  bar :: a+  baz :: a+  -- ^ Post-Haddock+  raz :: a+  -- ^ Another Post-Haddock++  -- | One more Haddock+  qux :: a+  -- Comment before a Haddock+  -- | And one more Haddock+  xyz :: a++  -- | Haddock followed by a blank line++  abc :: a
+ data/examples/declaration/class/newlines-between-methods-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/newlines-between-methods.hs view
@@ -0,0 +1,15 @@+class Num a where+  (+) :: a -> a -> a+  (-) :: a -> a -> a+  (*) :: a -> a -> a++  -- Comment before definition+  negate :: a -> a+  -- Comment after definition++  -- Separator++  abs :: a -> a+  signum :: a -> a+  -- Comment between unrelated definitions+  fromInteger :: Integer -> a
+ data/examples/declaration/class/poly-kinded-classes-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE PolyKinds #-}++class Foo (a :: k)++class+  Bar+    ( a :: -- Variable+        * -- Star+    )
+ data/examples/declaration/class/poly-kinded-classes.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE PolyKinds #-}++class Foo (a::k)++class Bar+    (a -- Variable+       :: * -- Star+    )
+ data/examples/declaration/class/single-parameters-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/single-parameters.hs view
@@ -0,0 +1,22 @@+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 ::+        (a,+         a) -- ^ First argument+        -> a -- ^ Second argument+        -> a -- ^ Return value++class BarBaz a where+    barbaz ::+        a -> b+    bazbar :: b -> a
+ data/examples/declaration/class/super-classes-out.hs view
@@ -0,0 +1,14 @@+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/super-classes.hs view
@@ -0,0 +1,9 @@+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-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-operators1.hs view
@@ -0,0 +1,19 @@+{-# 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-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-operators2.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-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/class/type-operators3.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TypeFamilies, TypeOperators, NoStarIsType, PolyKinds #-}++class PNum x where+  type (a :: x) * (b :: x)++instance PNum Nat where+  type a * b = ()
+ data/examples/declaration/data/deriving-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-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/deriving-strategies.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/deriving.hs view
@@ -0,0 +1,2 @@+newtype R r a = R (ReaderT r IO a)+  deriving (MonadReader r)
+ data/examples/declaration/data/empty-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE EmptyDataDecls #-}++data Foo
+ data/examples/declaration/data/empty.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE EmptyDataDecls #-}++data Foo
+ data/examples/declaration/data/existential-multiline-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/existential-multiline.hs view
@@ -0,0 +1,12 @@+{-# 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/existential-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.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/fat-multiline-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/fat-multiline.hs view
@@ -0,0 +1,11 @@+module Main where++-- | Something.++data Foo+  = Foo Int+        Int+    -- ^ Foo+  | Bar Bool+        Bool+    -- ^ Bar
+ data/examples/declaration/data/gadt-syntax-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE GADTSyntax #-}++data Foo where MKFoo :: a -> (a -> Bool) -> Foo
+ data/examples/declaration/data/gadt-syntax.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE GADTSyntax #-}++data Foo where { MKFoo :: a -> (a->Bool) -> Foo }
+ data/examples/declaration/data/gadt/multiline-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-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/multiline-where.hs view
@@ -0,0 +1,6 @@+data+  Foo+    a+    b+    c where+  Foo :: a -> b -> c -> Foo a b c
+ data/examples/declaration/data/gadt/multiline.hs view
@@ -0,0 +1,18 @@+module Main where++{-# LANGUAGE ExplicitForAll #-}++-- | 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/multiple-declaration-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/multiple-declaration.hs view
@@ -0,0 +1,11 @@+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-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/record.hs view
@@ -0,0 +1,12 @@+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-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/simple.hs view
@@ -0,0 +1,11 @@+module Main where++{-# LANGUAGE ExplicitForAll #-}++-- | 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 -> Foo 'Bool -- ^ But 'Bar' is also not too bad.+  Baz :: forall a. a -> Foo 'String -- ^ So is 'Baz'.
+ data/examples/declaration/data/gadt/strictness-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/gadt/strictness.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-out.hs view
@@ -0,0 +1,1 @@+data Foo a b = a `Foo` b
+ data/examples/declaration/data/infix.hs view
@@ -0,0 +1,1 @@+data Foo a b = a `Foo` b
+ data/examples/declaration/data/kind-annotations-out.hs view
@@ -0,0 +1,11 @@+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/kind-annotations.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-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-arg-parens.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-names-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/multiline-names.hs view
@@ -0,0 +1,23 @@+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/multiline-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.hs view
@@ -0,0 +1,10 @@+module Main where++-- | Here we have 'Foo'.++data Foo+  = Foo -- ^ One+  | Bar Int -- ^ Two+  | Baz -- ^ Three+  deriving+    (Eq, Show)
+ data/examples/declaration/data/newtype-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Something.+newtype Foo = Foo Int+  deriving (Eq, Show)
+ data/examples/declaration/data/newtype.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Something.++newtype Foo = Foo Int+  deriving (Eq, Show)
+ data/examples/declaration/data/operators-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/operators.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-out.hs view
@@ -0,0 +1,5 @@+data Optimisation+  = PETransform+  | -- | partial eval and associated transforms+    GeneralisedNatHack+  deriving (Show, Eq, Generic)
+ data/examples/declaration/data/partly-documented.hs view
@@ -0,0 +1,2 @@+data Optimisation = PETransform | GeneralisedNatHack -- ^ partial eval and associated transforms+  deriving (Show, Eq, Generic)
+ data/examples/declaration/data/record-multi-const-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-multi-const.hs view
@@ -0,0 +1,13 @@+module Main where++-- | Something.++data Foo = Foo+  { fooX :: Int -- ^ X+  , fooY :: Int -- ^ Y+  } |+  Bar+  { barX :: Int -- ^ X+  , barY :: Int -- ^ Y+  }+  deriving (Eq, Show)
+ data/examples/declaration/data/record-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-singleline-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/record-singleline.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Something.++data Foo = Foo { fooX :: Int , fooY :: Int }+  deriving (Eq, Show)
+ data/examples/declaration/data/record.hs view
@@ -0,0 +1,14 @@+module Main where++-- | Something.++data Foo = Foo+  { fooX :: Int -- ^ X+  , fooY :: Int -- ^ Y+  , fooBar, fooBaz :: NonEmpty (Identity Bool) -- ^ BarBaz+  , fooGag, fooGog :: NonEmpty (Indentity+                                  Bool)+    -- ^ GagGog+  , fooFoo+      , barBar :: Int -- ^ Huh!+  } deriving (Eq, Show)
+ data/examples/declaration/data/simple-broken-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-broken.hs view
@@ -0,0 +1,12 @@+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-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/simple.hs view
@@ -0,0 +1,6 @@+module Main where++-- | And here we have 'Foo'.++data Foo = Foo | Bar Int | Baz+  deriving (Eq, Show)
+ data/examples/declaration/data/strictness-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/strictness.hs view
@@ -0,0 +1,7 @@+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-out.hs view
@@ -0,0 +1,7 @@+data Foo+  = -- | Bar+    Bar+      Field1+      -- ^ Field 1+      Field2+      -- ^ Field 2
+ data/examples/declaration/data/unnamed-field-comment-0.hs view
@@ -0,0 +1,5 @@+data Foo+  = -- | Bar+    Bar+      Field1 -- ^ Field 1+      Field2 -- ^ Field 2
+ data/examples/declaration/data/unnamed-field-comment-1-out.hs view
@@ -0,0 +1,5 @@+data X+  = B+      !Int+      -- ^ y+      C
+ data/examples/declaration/data/unnamed-field-comment-1.hs view
@@ -0,0 +1,4 @@+data X+  = B+     !Int -- ^ y+     C
+ data/examples/declaration/data/with-comment-out.hs view
@@ -0,0 +1,4 @@+data A+  = B -- C+  | -- D+    E
+ data/examples/declaration/data/with-comment.hs view
@@ -0,0 +1,5 @@+data A =+     B  -- C++   -- D+   | E
+ data/examples/declaration/data/with-weird-haddock-out.hs view
@@ -0,0 +1,4 @@+data PlusLevel' t+  = -- | @n + ℓ@.+    Plus Integer (LevelAtom' t)+  deriving (Show, Data)
+ data/examples/declaration/data/with-weird-haddock.hs view
@@ -0,0 +1,2 @@+data PlusLevel' t = Plus Integer (LevelAtom' t)  -- ^ @n + ℓ@.+  deriving (Show, Data)
+ data/examples/declaration/default/default-out.hs view
@@ -0,0 +1,7 @@+default (Int, Foo, Bar)++default+  ( Int,+    Foo,+    Bar+  )
+ data/examples/declaration/default/default.hs view
@@ -0,0 +1,6 @@+default        (  Int , Foo     , Bar      )++default ( Int+               , Foo,+  Bar+           )
+ data/examples/declaration/deriving/multiline-out.hs view
@@ -0,0 +1,24 @@+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/multiline.hs view
@@ -0,0 +1,19 @@+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-out.hs view
@@ -0,0 +1,19 @@+deriving instance+  {-# OVERLAPPABLE #-}+  Ord+    Foo++deriving instance+  {-# OVERLAPPING #-}+  Num+    Foo++deriving instance+  {-# OVERLAPS #-}+  Read+    Foo++deriving instance+  {-# INCOHERENT #-}+  Show+    Foo
+ data/examples/declaration/deriving/overlapping.hs view
@@ -0,0 +1,17 @@+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-out.hs view
@@ -0,0 +1,17 @@+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/deriving/singleline.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-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-export.hs view
@@ -0,0 +1,8 @@+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-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/foreign/foreign-import.hs view
@@ -0,0 +1,20 @@+{-# 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+  :: FunPtr (Ptr GLUnurbs -> IO ())+  -- ^ This 'FunPtr' is extremely dangerous, beware+  ->         Ptr GLUnurbs -> IO ()
+ data/examples/declaration/instance/associated-data-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-data.hs view
@@ -0,0 +1,20 @@+{-# 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-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/associated-types.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE TypeFamilies #-}++instance Foo Int where type Bar Int = Double++instance Foo Double+  where+    type+      Bar+        Double+        =+          [Double]+++    type instance Baz  Double+      = [Double]
+ data/examples/declaration/instance/contexts-comments-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-comments.hs view
@@ -0,0 +1,18 @@+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-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/contexts.hs view
@@ -0,0 +1,14 @@+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-gadt-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-gadt.hs view
@@ -0,0 +1,10 @@+{-# 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-out.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE TypeFamilies #-}++newtype instance Foo [Double] = DoubleListFoo+  { unDoubleListFoo :: Double+  }
+ data/examples/declaration/instance/data-family-instances-newtype.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE TypeFamilies #-}+newtype instance Foo [Double] = DoubleListFoo {+    unDoubleListFoo :: Double+}+
+ data/examples/declaration/instance/data-family-instances-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.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/empty-instance-out.hs view
@@ -0,0 +1,3 @@+instance Typeable Int++instance Generic Int
+ data/examples/declaration/instance/empty-instance.hs view
@@ -0,0 +1,2 @@+instance Typeable Int+instance Generic Int where
+ data/examples/declaration/instance/instance-sigs-multiple-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/instance-sigs-multiple.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE InstanceSigs #-}++instance Applicative [] where+  pure ::+       a+    -> [a]+  pure a = [a]+  (<*>)+    :: [ a ] -> [ a ] -> [ a ]+  (<*>) _ _ = []
+ data/examples/declaration/instance/instance-sigs-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.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE InstanceSigs #-}++instance Eq Int+  where+    (==) :: Int -> Int -> Bool+    (==) _ _ = False++instance Ord Int where+    compare ::+           Int+        -> Int+        -> Ordering+    compare+        _+        _+        = GT
+ data/examples/declaration/instance/multi-parameter-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/multi-parameter.hs view
@@ -0,0 +1,6 @@+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-out.hs view
@@ -0,0 +1,5 @@+instance Num X where+  (+) = undefined++instance Num Y where+  (+) = undefined
+ data/examples/declaration/instance/newlines-after-where.hs view
@@ -0,0 +1,7 @@+instance Num X where+  (+) = undefined++instance Num Y where+++  (+) = undefined
+ data/examples/declaration/instance/newlines-between-methods-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/newlines-between-methods.hs view
@@ -0,0 +1,16 @@+instance Num a => Num (Diff a) where+  D u dudx + D v dvdx = D (u + v) (dudx + dvdx)+  D u dudx - D v dvdx = D (u - v) (dudx - dvdx)+  D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx)++  -- Comment before definition+  negate (D u dudx) = D (-u) (-dudx)+  negate (Z u dudx) = undefined+  -- Comment after definition++  -- Separator++  abs (D u _) = D (abs u) (signum u)+  signum (D u _) = D (signum u) 0+  -- Comment between unrelated definitions+  fromInteger n = D (fromInteger n) 0
+ data/examples/declaration/instance/overlappable-instances-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/overlappable-instances.hs view
@@ -0,0 +1,13 @@+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-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/single-parameter.hs view
@@ -0,0 +1,10 @@+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-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/instance/type-family-instances.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-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/basic1.hs view
@@ -0,0 +1,17 @@+{-# 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-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/basic2.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-out.hs view
@@ -0,0 +1,3 @@+{-# RULES++  #-}
+ data/examples/declaration/rewrite-rule/empty.hs view
@@ -0,0 +1,2 @@+{-# RULES+     #-}
+ data/examples/declaration/rewrite-rule/forall-0-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-0.hs view
@@ -0,0 +1,8 @@+{-# 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-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/forall-1.hs view
@@ -0,0 +1,17 @@+{-# 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-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/phase.hs view
@@ -0,0 +1,19 @@+{-# 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-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/prelude1.hs view
@@ -0,0 +1,17 @@+{-# 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-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/prelude2.hs view
@@ -0,0 +1,29 @@+{-# 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-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/prelude3.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-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/prelude4.hs view
@@ -0,0 +1,9 @@+{-# 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-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/rewrite-rule/type-signature.hs view
@@ -0,0 +1,12 @@+{-# 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-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/multi-line.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-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE RoleAnnotations #-}++type role Ptr representational++type role A nominal nominal++type role B _ phantom++type role C _ _
+ data/examples/declaration/role-annotation/single-line.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE MagicHash #-}++type role Ptr representational++type role A nominal nominal++type role B _ phantom+type role C _ _
+ data/examples/declaration/signature/complete/complete-out.hs view
@@ -0,0 +1,10 @@+{-# COMPLETE A, B, C :: Foo #-}++{-# COMPLETE A, B #-}++{-# COMPLETE+  A,+  B,+  C ::+    Foo+  #-}
+ data/examples/declaration/signature/complete/complete.hs view
@@ -0,0 +1,13 @@+{-#   ComPlETe       A  , B, C::         Foo++  #-}++{-#    COMPLETE          A , B+   #-}++{-#   ComPlETE+      A  , +    B, C+++    ::         Foo#-}
+ data/examples/declaration/signature/fixity/infix-out.hs view
@@ -0,0 +1,3 @@+infix 0 <?>++infix 9 <^-^>
+ data/examples/declaration/signature/fixity/infix.hs view
@@ -0,0 +1,2 @@+infix 0 <?>+infix 9 <^-^>
+ data/examples/declaration/signature/fixity/infixl-out.hs view
@@ -0,0 +1,3 @@+infixl 8 ***++infixl 0 $, *, +, &&, **
+ data/examples/declaration/signature/fixity/infixl.hs view
@@ -0,0 +1,2 @@+infixl 8 ***+infixl 0 $, *, +, &&, **
+ data/examples/declaration/signature/fixity/infixr-out.hs view
@@ -0,0 +1,3 @@+infixr 8 `Foo`++infixr 0 ***, &&&
+ data/examples/declaration/signature/fixity/infixr.hs view
@@ -0,0 +1,2 @@+infixr 8 `Foo`+infixr 0 ***, &&&
+ data/examples/declaration/signature/inline/conlike-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/conlike.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-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/inline.hs view
@@ -0,0 +1,18 @@+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-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/inlineable.hs view
@@ -0,0 +1,13 @@+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-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/inline/noinline.hs view
@@ -0,0 +1,13 @@+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-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/minimal/minimal.hs view
@@ -0,0 +1,10 @@+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-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/multiline.hs view
@@ -0,0 +1,13 @@+{-# 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-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE PatternSynonyms #-}++pattern Arrow :: Type -> Type -> Type++pattern Foo, Bar :: Type -> Type -> Type
+ data/examples/declaration/signature/pattern/single-line.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-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/set-cost-centre/set-cost-centre.hs view
@@ -0,0 +1,16 @@+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-instance-out.hs view
@@ -0,0 +1,14 @@+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/specialize/specialize-instance.hs view
@@ -0,0 +1,11 @@+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/specialize/specialize-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.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/type/arguments-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/arguments.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-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-multi-line.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-out.hs view
@@ -0,0 +1,7 @@+functionName ::+  (C1, C2, C3) =>+  a ->+  b ->+  c ->+  d ->+  (a, b, c, d)
+ data/examples/declaration/signature/type/context-single-line.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-out.hs view
@@ -0,0 +1,3 @@+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.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/long-function-name-out.hs view
@@ -0,0 +1,6 @@+longFunctionName ::+  a ->+  b ->+  c ->+  d ->+  (a, b, c, d)
+ data/examples/declaration/signature/type/long-function-name.hs view
@@ -0,0 +1,6 @@+longFunctionName+  :: a+  -> b+  -> c+  -> d+  -> (a, b, c, d)
+ data/examples/declaration/signature/type/long-multiline-applications-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/long-multiline-applications.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-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/multi-value.hs view
@@ -0,0 +1,14 @@+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-out.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++foo :: forall a. Show a => a -> String+foo = const ()
+ data/examples/declaration/signature/type/unicode.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE UnicodeSyntax #-}++foo ∷ ∀a. Show a ⇒ a → String+foo = const ()
+ data/examples/declaration/splice/bracket-declaration-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.hs view
@@ -0,0 +1,22 @@+{-# 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-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/bracket.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE TemplateHaskell #-}++foo   = [|      foo bar+  |]++foo = [e| foo bar+  |]++foo = [t|       Char |]++foo = [|| foo bar+  ||]
+ data/examples/declaration/splice/grouped-splices-out.hs view
@@ -0,0 +1,3 @@+$(deriveJSON fieldLabelMod ''A)+$(deriveJSON fieldLabelMod ''B)+$(deriveJSON fieldLabelMod ''C)
+ data/examples/declaration/splice/grouped-splices.hs view
@@ -0,0 +1,3 @@+$(deriveJSON fieldLabelMod ''A)+$(deriveJSON fieldLabelMod ''B)+$(deriveJSON fieldLabelMod ''C)
+ data/examples/declaration/splice/quasiquote-out.hs view
@@ -0,0 +1,12 @@+{-# LANGUAGE QuasiQuotes #-}++x = [foo|    foo bar   |]++x =+  [e|    foo+ bar  {- -}+  |]++[d|    foo bar++|]
+ data/examples/declaration/splice/quasiquote.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE QuasiQuotes #-}++x = [foo|    foo bar   |]++x = [e|    foo+ bar  {- -}+  |]++[d|    foo bar++|]
+ data/examples/declaration/splice/quotes-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/quotes.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-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/splice-decl.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-out.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE TemplateHaskell #-}++x =+  $$( foo bar+    )++x = $$foo
+ data/examples/declaration/splice/typed-splice.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE TemplateHaskell #-}++x      =    $$(   foo  bar +  )++x     =     $$foo
+ data/examples/declaration/splice/untyped-splice-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE TemplateHaskell #-}++x = $(foo bar)++x =+  $( foo+       bar+   )++x = $foo
+ data/examples/declaration/splice/untyped-splice.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TemplateHaskell #-}+x      =    $(      foo bar     )++x = $(   +  foo  +      bar      )++x = $foo
+ data/examples/declaration/type-families/closed-type-family/infix-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/infix.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-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/injective.hs view
@@ -0,0 +1,4 @@+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-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/multi-line.hs view
@@ -0,0 +1,14 @@+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-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/no-annotation.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-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/simple.hs view
@@ -0,0 +1,8 @@+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-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-equal-sign.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-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/closed-type-family/with-forall.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-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+data family Array e
+ data/examples/declaration/type-families/data-family/no-annotation.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Documentation.++data family Array e
+ data/examples/declaration/type-families/data-family/simple-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+data family GMap k :: Type -> Type
+ data/examples/declaration/type-families/data-family/simple.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Documentation.++data family GMap k :: Type -> Type
+ data/examples/declaration/type-families/type-family/injective-out.hs view
@@ -0,0 +1,3 @@+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/injective.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-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/no-annotation.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Documentation.++type family F a b :: Type -> Type
+ data/examples/declaration/type-families/type-family/operator-out.hs view
@@ -0,0 +1,3 @@+type family a ! b++type family a . b
+ data/examples/declaration/type-families/type-family/operator.hs view
@@ -0,0 +1,2 @@+type family a ! b+type family a . b
+ data/examples/declaration/type-families/type-family/simple-out.hs view
@@ -0,0 +1,4 @@+module Main where++-- | Documentation.+type family Elem c :: Type
+ data/examples/declaration/type-families/type-family/simple.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Documentation.++type family Elem c :: Type
+ data/examples/declaration/type-synonyms/multi-line-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/multi-line.hs view
@@ -0,0 +1,17 @@+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-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/simple.hs view
@@ -0,0 +1,9 @@+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-out.hs view
@@ -0,0 +1,3 @@+type Elims =+  -- | eliminations ordered left-to-right.+  [Elim]
+ data/examples/declaration/type-synonyms/with-weird-haddock.hs view
@@ -0,0 +1,1 @@+type Elims = [Elim]  -- ^ eliminations ordered left-to-right.
+ data/examples/declaration/type/forall-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/forall.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-out.hs view
@@ -0,0 +1,6 @@+type A = "foo"++type B =+  "foo\+  \bar" ->+  ()
+ data/examples/declaration/type/lits.hs view
@@ -0,0 +1,4 @@+type A = "foo"++type B = "foo\+         \bar" -> ()
+ data/examples/declaration/type/misc-kind-signatures-out.hs view
@@ -0,0 +1,5 @@+instance DemoteNodeTypes ('[] :: [NodeType]) where+  demoteNodeTypes _ = []++b :: (Bool :: *)+b = True
+ data/examples/declaration/type/misc-kind-signatures.hs view
@@ -0,0 +1,5 @@+instance DemoteNodeTypes ('[] :: [NodeType]) where+    demoteNodeTypes _ = []++b :: (Bool :: *)+b = True
+ data/examples/declaration/type/promotion-out.hs view
@@ -0,0 +1,19 @@+type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge]++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.hs view
@@ -0,0 +1,15 @@+type Foo = Cluster '[ 'NodeCore, 'NodeRelay', 'NodeEdge ]++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/splice-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TemplateHaskell #-}++type Foo = $(bar [t|Int|])
+ data/examples/declaration/type/splice.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TemplateHaskell #-}++type   Foo  = $(         bar [t|Int|] )
+ data/examples/declaration/type/type-applications-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TypeApplications #-}++type P = K @Bool @(Bool :: *) 'True 'False
+ data/examples/declaration/type/type-applications.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE TypeApplications #-}++type P = K @Bool @(Bool :: *) 'True 'False
+ data/examples/declaration/type/visible-forall-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/type/visible-forall.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-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-0.hs view
@@ -0,0 +1,12 @@+foo =+  f1+    p1+    p2 p3++foo' = f2 p1+  p2+  p3++foo'' =+  f3 p1 p2+    p3
+ data/examples/declaration/value/function/application-1-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/application-1.hs view
@@ -0,0 +1,14 @@+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/arithmetic-sequences-out.hs view
@@ -0,0 +1,24 @@+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/arithmetic-sequences.hs view
@@ -0,0 +1,15 @@+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-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/multiline-case.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE Arrows #-}++f = proc x -> do+  x+    <- case x of X -> x+    -< y+  a -< b
+ data/examples/declaration/value/function/arrow/proc-applications-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-applications.hs view
@@ -0,0 +1,17 @@+{-# 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-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-cases.hs view
@@ -0,0 +1,17 @@+{-# 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-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-complex.hs view
@@ -0,0 +1,49 @@+{-# 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 -- Only left case is relevant+            of 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-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-simple1.hs view
@@ -0,0 +1,20 @@+{-# 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-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-do-simple2.hs view
@@ -0,0 +1,20 @@+{-# 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-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-forms1.hs view
@@ -0,0 +1,19 @@+{-# 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-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-forms2.hs view
@@ -0,0 +1,19 @@+{-# 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-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-ifs.hs view
@@ -0,0 +1,14 @@+{-# 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-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-lambdas.hs view
@@ -0,0 +1,10 @@+{-# 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-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-lets.hs view
@@ -0,0 +1,14 @@+{-# 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-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/proc-parentheses.hs view
@@ -0,0 +1,12 @@+{-# 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-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/arrow/recursive-procs.hs view
@@ -0,0 +1,18 @@+{-# 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-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-0.hs view
@@ -0,0 +1,5 @@+mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a+mergeErrorReply err1 reply -- XXX where to put it?+    = case reply of+        Ok x state err2 -> Ok x state (mergeError err1 err2)+        Error err2      -> Error (mergeError err1 err2)
+ data/examples/declaration/value/function/awkward-comment-1-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/awkward-comment-1.hs view
@@ -0,0 +1,7 @@+doForeign :: Vars -> [Name] -> [Term] -> Idris LExp+doForeign x = x+  where+    splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits+        = do let l' = toFDesc l+             r' <- irTerm (sMN 0 "__foreignCall") vs env r+             return (l', r')
+ data/examples/declaration/value/function/backticks-lhs-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/backticks-lhs.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/backticks-out.hs view
@@ -0,0 +1,1 @@+foo x y = x `bar` y
+ data/examples/declaration/value/function/backticks.hs view
@@ -0,0 +1,1 @@+foo x y = x `bar` y
+ data/examples/declaration/value/function/block-arguments-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/block-arguments.hs view
@@ -0,0 +1,30 @@+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-out.hs view
@@ -0,0 +1,1 @@+x = return ()
+ data/examples/declaration/value/function/builtin-syntax.hs view
@@ -0,0 +1,1 @@+x = return ()
+ data/examples/declaration/value/function/case-multi-line-guards-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-multi-line-guards.hs view
@@ -0,0 +1,15 @@+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-multi-line-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.hs view
@@ -0,0 +1,23 @@+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-single-line-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/case-single-line.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-out.hs view
@@ -0,0 +1,15 @@+handleStuff =+  handle+    [ \ExceptionA ->+        something,+      \ExceptionB ->+        somethingElse+    ]++handleStuff =+  handle+    [ foo+        bar,+      baz+        qux+    ]
+ data/examples/declaration/value/function/complex-list.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-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-line1.hs view
@@ -0,0 +1,10 @@+{-# 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-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-line2.hs view
@@ -0,0 +1,15 @@+{-# 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-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-line3.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-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-multi-line4.hs view
@@ -0,0 +1,15 @@+{-# 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-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/comprehension/transform-single-line.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-out.hs view
@@ -0,0 +1,4 @@+foo = do+  ( bar+      baz+    )
+ data/examples/declaration/value/function/do-single-multi.hs view
@@ -0,0 +1,2 @@+foo = do (bar+          baz)
+ data/examples/declaration/value/function/do-where-out.hs view
@@ -0,0 +1,5 @@+f :: Maybe Int+f = do+  return c+  where+    c = 0
+ data/examples/declaration/value/function/do-where.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-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/applications-and-parens.hs view
@@ -0,0 +1,6 @@+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-out.hs view
@@ -0,0 +1,19 @@+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/blocks.hs view
@@ -0,0 +1,17 @@+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-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-alignment.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-out.hs view
@@ -0,0 +1,7 @@+foo = do+  bar+  -- foo+  baz++  -- foo+  quux
+ data/examples/declaration/value/function/do/comment-spacing.hs view
@@ -0,0 +1,7 @@+foo = do+  bar+  -- foo+  baz++  -- foo+  quux
+ data/examples/declaration/value/function/do/expr-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/expr.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-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/hang-rhs-arrow.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-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/let.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-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/operator-and-parens.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-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-mdo.hs view
@@ -0,0 +1,8 @@+{-# 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-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/do/recursive-do-rec.hs view
@@ -0,0 +1,20 @@+{-# 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-out.hs view
@@ -0,0 +1,2 @@+foo :: (a ~ b) => a -> b -> Int+foo = undefined
+ data/examples/declaration/value/function/equality-constraints.hs view
@@ -0,0 +1,2 @@+foo :: (a ~ b) => a -> b -> Int+foo = undefined
+ data/examples/declaration/value/function/explicit-type-out.hs view
@@ -0,0 +1,5 @@+foo = 5 :: Int++bar =+  5 ::+    Int
+ data/examples/declaration/value/function/explicit-type.hs view
@@ -0,0 +1,4 @@+foo = 5 :: Int++bar = 5+  :: Int
+ data/examples/declaration/value/function/fancy-forall-0-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-0.hs view
@@ -0,0 +1,6 @@+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-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/fancy-forall-1.hs view
@@ -0,0 +1,6 @@+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-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/guards.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-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-multi-line.hs view
@@ -0,0 +1,22 @@+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-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-single-line.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-out.hs view
@@ -0,0 +1,8 @@+foo =+  if undefined+    then -- then comment+      undefined+    else -- else comment++    do+      undefined
+ data/examples/declaration/value/function/if-with-comment.hs view
@@ -0,0 +1,8 @@+foo =+  if undefined+    -- then comment+    then undefined+    -- else comment+    else+      do+        undefined
+ data/examples/declaration/value/function/implicit-params-out.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE ImplicitParams #-}++sortBy :: (a -> a -> Bool) -> [a] -> [a]++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.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ImplicitParams #-}+sortBy :: (a -> a -> Bool) -> [a] -> [a]++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/infix/applicative-out.hs view
@@ -0,0 +1,4 @@+f =+  Foo <$> bar+    <*> baz+    <*> baz'
+ data/examples/declaration/value/function/infix/applicative.hs view
@@ -0,0 +1,4 @@+f =+  Foo <$> bar+      <*> baz+      <*> baz'
+ data/examples/declaration/value/function/infix/comments-out.hs view
@@ -0,0 +1,8 @@+main =+  bar $ -- bar+    baz -- baz++bar $+  {- foo+   -}+  bar
+ data/examples/declaration/value/function/infix/comments.hs view
@@ -0,0 +1,8 @@+main =+  bar $ -- bar+    baz -- baz++bar $+  {- foo+   -}+  bar
+ data/examples/declaration/value/function/infix/do-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/do.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-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.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/hanging-out.hs view
@@ -0,0 +1,22 @@+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.hs view
@@ -0,0 +1,19 @@+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/lenses-out.hs view
@@ -0,0 +1,20 @@+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.hs view
@@ -0,0 +1,16 @@+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/simple-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/simple.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-out.hs view
@@ -0,0 +1,3 @@+main = print ('a' → 'a')+  where+    (→) = (,)
+ data/examples/declaration/value/function/infix/unicode.hs view
@@ -0,0 +1,3 @@+main = print ('a' → 'a')+  where+    (→) = (,)
+ data/examples/declaration/value/function/lambda-case-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-case.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-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-line1.hs view
@@ -0,0 +1,14 @@+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-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-multi-line2.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-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/lambda-single-line.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-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.hs view
@@ -0,0 +1,27 @@+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-nested-out.hs view
@@ -0,0 +1,3 @@+_ = _+  where+    _ = [_ | let _ = _]
+ data/examples/declaration/value/function/let-nested.hs view
@@ -0,0 +1,3 @@+_ = _+  where+    _ = [_ | let _ = _]
+ data/examples/declaration/value/function/let-single-line-out.hs view
@@ -0,0 +1,10 @@+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/let-single-line.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-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-comprehensions.hs view
@@ -0,0 +1,22 @@+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/multi-way-if-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/multi-way-if.hs view
@@ -0,0 +1,14 @@+{-# 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-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/multiline-arguments.hs view
@@ -0,0 +1,4 @@+foo :: Int -> Int -> Int -> Int+foo (Foo g o)+    (Bar+       x y) z = x
+ data/examples/declaration/value/function/multiple-guards-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-guards.hs view
@@ -0,0 +1,13 @@+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-out.hs view
@@ -0,0 +1,3 @@+foo :: Int -> Int+foo 5 = 10+foo _ = 12
+ data/examples/declaration/value/function/multiple-matches.hs view
@@ -0,0 +1,3 @@+foo :: Int -> Int+foo 5 = 10+foo _ = 12
+ data/examples/declaration/value/function/negation-out.hs view
@@ -0,0 +1,8 @@+foo :: Int+foo = (-2)++bar :: Int+bar = -2++baz :: Int+baz = - 2
+ data/examples/declaration/value/function/negation.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-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/newline-single-line-body.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-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-0.hs view
@@ -0,0 +1,17 @@+foo =+  bar+  +++    {- some comment -}+    case foo of+      a -> a++foo =+  bar+    ++ {- some comment -}+    case foo of+      a -> a++foo =+  bar+    ++ case foo of {- some comment -}+      a -> a
+ data/examples/declaration/value/function/operator-comments-1-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-1.hs view
@@ -0,0 +1,17 @@+foo =+  bar+  +++    -- some comment+    case foo of+      a -> a++foo =+  bar+    ++ -- some comment+    case foo of+      a -> a++foo =+  bar+    ++ case foo of -- some comment+      a -> a
+ data/examples/declaration/value/function/operator-comments-2-out.hs view
@@ -0,0 +1,5 @@+x =+  y+    ++ f g -- commentA+    -- commentB+    -- commentC
+ data/examples/declaration/value/function/operator-comments-2.hs view
@@ -0,0 +1,4 @@+x  =+      y ++ -- commentA+-- commentB+      f g -- commentC
+ data/examples/declaration/value/function/operator-sections-out.hs view
@@ -0,0 +1,13 @@+foo = (0 +)++bar = (<> "hello")++baz =+  ( 1 * 2+      ++  )+    ( *+        3 ^ 5+    )++quux = (,) <$> foo <$> bar
+ data/examples/declaration/value/function/operator-sections.hs view
@@ -0,0 +1,9 @@+foo = (0  +)+bar = ( <> "hello" )+baz =+    ( 1 * 2+      + )+    ( *+      3 ^ 5)++quux = (,) <$> foo <$> bar
+ data/examples/declaration/value/function/operators-out.hs view
@@ -0,0 +1,5 @@+a =+  b & c .~ d+    & e+      %~ f+        g
+ data/examples/declaration/value/function/operators.hs view
@@ -0,0 +1,4 @@+a =+  b & c .~ d+    & e %~ f+            g
+ data/examples/declaration/value/function/overindentation-out.hs view
@@ -0,0 +1,11 @@+reallyincrediblyLongName =+  f+    a+    A+      { reallyincrediblyLongName =+          f+            a+            A+              { reallyincrediblyLongName+              }+      }
+ data/examples/declaration/value/function/overindentation.hs view
@@ -0,0 +1,9 @@+reallyincrediblyLongName = f+  a+  A+    { reallyincrediblyLongName = f+        a+        A+          { reallyincrediblyLongName+          }+    }
+ data/examples/declaration/value/function/overloaded-labels-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE OverloadedLabels #-}++foo = #field++bar = (#this) (#that)
+ data/examples/declaration/value/function/overloaded-labels.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE OverloadedLabels #-}++foo = #field+bar = (#this ) ( #that)
+ data/examples/declaration/value/function/parallel-comprehensions-complex-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-complex.hs view
@@ -0,0 +1,24 @@+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 *                         -- Baz 2+    z|                          -- 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 +                       -- Bar bar 2+      b,                        -- Bar bar 3+    j <-                        -- Bar baz 1+      a + b                     -- Bar baz 2+  ]
+ data/examples/declaration/value/function/parallel-comprehensions-single-line-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/parallel-comprehensions-single-line.hs view
@@ -0,0 +1,4 @@+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-out.hs view
@@ -0,0 +1,1 @@+f = p (do foo; bar) baz
+ data/examples/declaration/value/function/parens.hs view
@@ -0,0 +1,1 @@+f = p (do foo; bar) baz
+ data/examples/declaration/value/function/parenthesis-lhs-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/parenthesis-lhs.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-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/as-pattern.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-out.hs view
@@ -0,0 +1,8 @@+( getNodeSettingsR+    :<|> getNodeInfoR+    :<|> getNextUpdateR+    :<|> restartNodeR+  )+  :<|> ( getUtxoR+           :<|> getConfirmedProposalsR+         ) = client nodeV1Api
+ data/examples/declaration/value/function/pattern/famous-cardano-pattern.hs view
@@ -0,0 +1,7 @@+(       getNodeSettingsR+ :<|>   getNodeInfoR+ :<|>   getNextUpdateR+ :<|>   restartNodeR+ ):<|>( getUtxoR+ :<|>   getConfirmedProposalsR+ ) = client nodeV1Api
+ data/examples/declaration/value/function/pattern/multiline-case-pattern-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/multiline-case-pattern.hs view
@@ -0,0 +1,12 @@+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-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/n-plus-k-pattern.hs view
@@ -0,0 +1,10 @@+{-# 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-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/pattern-bind.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-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/quasi-quotes-pattern.hs view
@@ -0,0 +1,9 @@+{-# 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-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/record-patterns.hs view
@@ -0,0 +1,18 @@+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-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/sig-pattern.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-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.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TemplateHaskell #-}++singleLine = case () of+  $x -> ()+  $(y "something") -> ()++multiline = case () of+  $(x+    + y) -> ()+  $(y+      "something") -> ()
+ data/examples/declaration/value/function/pattern/strictness-out.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE BangPatterns #-}++!a = ()++~b = ()
+ data/examples/declaration/value/function/pattern/strictness.hs view
@@ -0,0 +1,4 @@+{-# LANGUAGE BangPatterns #-}++!a = ()+~b = ()
+ data/examples/declaration/value/function/pattern/unboxed-sum-pattern-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/unboxed-sum-pattern.hs view
@@ -0,0 +1,23 @@+{-# 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-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/pattern/view-pattern.hs view
@@ -0,0 +1,12 @@+{-# 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-out.hs view
@@ -0,0 +1,11 @@+sccfoo = {-# SCC foo #-} 1++sccbar =+  {-# SCC "barbaz" #-}+  "hello"++corefoo = {-# CORE "foo" #-} 1++corebar =+  {-# CORE "bar baz" #-}+  "hello"
+ data/examples/declaration/value/function/pragmas.hs view
@@ -0,0 +1,7 @@+sccfoo = {-# SCC foo#-}  1+sccbar = {-# SCC "barbaz"#-}+  "hello"++corefoo = {-# CORE "foo"#-}  1+corebar = {-# CORE "bar baz"#-}+  "hello"
+ data/examples/declaration/value/function/prefix-out.hs view
@@ -0,0 +1,1 @@+foo x y = (+) x y
+ data/examples/declaration/value/function/prefix.hs view
@@ -0,0 +1,1 @@+foo x y = (+) x y
+ data/examples/declaration/value/function/quasi-quotes-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/quasi-quotes.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE QuasiQuotes #-}+singleline :: Value+singleline = [yamlQQ|something|]++multiline :: Value+multiline = [yamlQQ| name: John Doe+age: 23++something: foo+|]
+ data/examples/declaration/value/function/simple-out.hs view
@@ -0,0 +1,3 @@+bar x = x++baz = x
+ data/examples/declaration/value/function/simple.hs view
@@ -0,0 +1,2 @@+bar x = x+baz = x
+ data/examples/declaration/value/function/splice-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE TemplateHaskell #-}++bar = $bar++bar' = $(bar "something")++baz = $$baz++baz' = $$(baz "something")
+ data/examples/declaration/value/function/splice.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-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/static-pointers.hs view
@@ -0,0 +1,13 @@+{-# 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-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE MagicHash #-}++foo = "foobar"++bar = "foo\&barbaz"++baz =+  "foo\+  \bar\+  \baz"
+ data/examples/declaration/value/function/strings.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE MagicHash #-}++foo = "foobar"+bar = "foo\&bar\   \baz"+baz = "foo\+      \bar\+    \baz"
+ data/examples/declaration/value/function/tricky-parens-out.hs view
@@ -0,0 +1,4 @@+handleStuff =+  ( let foo = foo+     in foo+  )
+ data/examples/declaration/value/function/tricky-parens.hs view
@@ -0,0 +1,4 @@+handleStuff =+  ( let foo = foo+     in foo+  )
+ data/examples/declaration/value/function/tuple-sections-out.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TupleSections #-}++foo = (,2)++bar = (,5,)++baz =+  (,,5,6,7,,,)
+ data/examples/declaration/value/function/tuple-sections.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TupleSections #-}++foo = (,2)+bar = (,5,)+baz = (+    ,,5,6,+    7,,,+  )
+ data/examples/declaration/value/function/tuples-out.hs view
@@ -0,0 +1,14 @@+foo = (1, 2, 3)++bar =+  ( 1,+    2,+    3+  )++handleStuff =+  ( let foo = foo+     in foo,+    let bar = bar+     in bar+  )
+ data/examples/declaration/value/function/tuples.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-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/type-applications.hs view
@@ -0,0 +1,13 @@+{-# 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-out.hs view
@@ -0,0 +1,5 @@+foo x = x :: Int++bar x =+  Just x ::+    Maybe String
+ data/examples/declaration/value/function/typed-expressions.hs view
@@ -0,0 +1,3 @@+foo x = x::Int+bar x = Just x ::+  Maybe String
+ data/examples/declaration/value/function/typed-hole-out.hs view
@@ -0,0 +1,5 @@+foo = 1 `_` 2++bar = 1 `_a` 2++baz = _ `something` _
+ data/examples/declaration/value/function/typed-hole.hs view
@@ -0,0 +1,5 @@+foo = 1 `_` 2++bar = 1 `_a` 2++baz = _ `something` _
+ data/examples/declaration/value/function/unboxed-string-lit-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE MagicHash #-}++main = new "p"#
+ data/examples/declaration/value/function/unboxed-string-lit.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE MagicHash #-}++main = new "p"#
+ data/examples/declaration/value/function/unboxed-sums-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE UnboxedSums #-}++foo = (# 1 | #)++bar = (# | | 2 | #)++baz =+  (#+    | | | 10 | | | | |+  #)
+ data/examples/declaration/value/function/unboxed-sums.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE UnboxedSums #-}++foo = (# 1 | #)+bar = (# | |2| #)+baz = (# |+  | | 10 | | | |+  | #)
+ data/examples/declaration/value/function/unboxed-tuples-out.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE UnboxedTuples #-}++foo = (# 1, 2, 3 #)++bar =+  (#+    1,+    2,+    3+  #)
+ data/examples/declaration/value/function/unboxed-tuples.hs view
@@ -0,0 +1,7 @@+{-# LANGUAGE UnboxedTuples #-}++foo = (# 1,2,3 #)+bar = (#+    1,+    2,+    3 #)
+ data/examples/declaration/value/function/where-nested-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/function/where-nested.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/function/where-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.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/other/comments-get-before-op-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/comments-get-before-op.hs view
@@ -0,0 +1,11 @@+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-out.hs view
@@ -0,0 +1,6 @@+x :: [Int]+x =+  [ 1,+    2,+    somethingSomething 3+  ]
+ data/examples/declaration/value/other/line-multi-line.hs view
@@ -0,0 +1,6 @@+x :: [Int]+x = [+  1+  , 2+  , somethingSomething 3+  ]
+ data/examples/declaration/value/other/line-single-line-out.hs view
@@ -0,0 +1,2 @@+x :: [Int]+x = [1, 2, 3]
+ data/examples/declaration/value/other/line-single-line.hs view
@@ -0,0 +1,2 @@+x :: [Int]+x = [1,2,3]
+ data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs view
@@ -0,0 +1,28 @@+{-# 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
@@ -0,0 +1,21 @@+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE NamedFieldPuns #-}++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/explicitely-bidirectional-out.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE PatternSynonyms #-}++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.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE PatternSynonyms #-}++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/unidirectional-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/value/pattern-synonyms/unidirectional.hs view
@@ -0,0 +1,20 @@+{-# 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-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-multiline.hs view
@@ -0,0 +1,4 @@+{-# WArNING test,+  foo ["These are bad functions", "Really bad!"] #-}+test :: IO ()+test = pure ()
+ data/examples/declaration/warning/warning-single-line-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/declaration/warning/warning-single-line.hs view
@@ -0,0 +1,15 @@+{-# 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-out.hs view
@@ -0,0 +1,7 @@+-- x++import qualified -- x+  Bar+import qualified -- x+  Baz+import Foo
+ data/examples/import/comments-inside-imports.hs view
@@ -0,0 +1,9 @@+import -- x+   Foo++import -- x+  qualified Bar++import qualified+  -- x+  Baz
+ data/examples/import/comments-per-import-out.hs view
@@ -0,0 +1,4 @@+-- (1)+import Bar -- (2)+import Baz -- (3)+import Foo
+ data/examples/import/comments-per-import.hs view
@@ -0,0 +1,3 @@+import Foo -- (1)+import Bar -- (2)+import Baz -- (3)
+ data/examples/import/explicit-imports-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-with-comments-out.hs view
@@ -0,0 +1,6 @@+import qualified MegaModule as M+  ( -- (1)+    (<<<), -- (2)+    (>>>),+    Either, -- (3)+  )
+ data/examples/import/explicit-imports-with-comments.hs view
@@ -0,0 +1,5 @@+import qualified MegaModule as M+  ( (>>>) -- (1)+  , (<<<) -- (2)+  , Either -- (3)+  )
+ data/examples/import/explicit-imports.hs view
@@ -0,0 +1,2 @@+import qualified MegaModule as M+  ((>>>), MonadBaseControl, void, MaybeT(..), join, Maybe(Nothing, Just), liftIO, Either, (<<<), Monad(return, (>>=), (>>)))
+ data/examples/import/explicit-prelude-out.hs view
@@ -0,0 +1,3 @@+import Aaa+import Zzz+import Prelude
+ data/examples/import/explicit-prelude.hs view
@@ -0,0 +1,3 @@+import Aaa+import Prelude+import Zzz
+ data/examples/import/misc-out.hs view
@@ -0,0 +1,11 @@+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/misc.hs view
@@ -0,0 +1,13 @@+import A hiding+  ( foobarbazqux+  , foobarbazqux+  , foobarbazqux+  , foobarbazqux+  , foobarbazqux+  , foobarbazqux+  , foobarbazqux+  )++import Name hiding ()++import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)
+ data/examples/import/nested-explicit-imports-out.hs view
@@ -0,0 +1,10 @@+import qualified MegaModule as M+  ( (<<<),+    (>>>),+    Either,+    Monad+      ( (>>),+        (>>=),+        return+      ),+  )
+ data/examples/import/nested-explicit-imports.hs view
@@ -0,0 +1,2 @@+import qualified MegaModule as M ((>>>), Either, (<<<), Monad(+  return, (>>=), (>>)))
+ data/examples/import/qualified-post-out.hs view
@@ -0,0 +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)
+ data/examples/import/qualified-post.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ImportQualifiedPost #-}++import qualified Data.Text as T+import qualified Data.Text (a, c, b)+import Data.Text qualified hiding (c, b, a)
+ data/examples/import/qualified-prelude-out.hs view
@@ -0,0 +1,4 @@+module P where++import qualified Prelude+import Prelude hiding ((.), id)
+ data/examples/import/qualified-prelude.hs view
@@ -0,0 +1,4 @@+module P where++import Prelude hiding (id, (.))+import qualified Prelude
+ data/examples/import/simple-out.hs view
@@ -0,0 +1,6 @@+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)
+ data/examples/import/simple.hs view
@@ -0,0 +1,6 @@+import Data.Text+import Data.Text+import qualified Data.Text as T+import qualified Data.Text (a, c, b)+import Data.Text (a, b, c)+import Data.Text hiding (c, b, a)
+ data/examples/import/sorted-out.hs view
@@ -0,0 +1,3 @@+import A+import B+import C
+ data/examples/import/sorted.hs view
@@ -0,0 +1,3 @@+import B+import A+import C
+ data/examples/module-header/double-dot-with-names-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-dot-with-names.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-out.hs view
@@ -0,0 +1,2 @@+#!/usr/bin/env stack+#!/usr/bin/env stack
+ data/examples/module-header/double-shebangs.hs view
@@ -0,0 +1,2 @@+#!/usr/bin/env stack+#!/usr/bin/env stack
+ data/examples/module-header/empty-out.hs view
+ data/examples/module-header/empty.hs view
+ data/examples/module-header/leading-empty-line-out.hs view
@@ -0,0 +1,11 @@+-- |+-- 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/leading-empty-line.hs view
@@ -0,0 +1,11 @@+-- |+-- 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-out.hs view
@@ -0,0 +1,4 @@+module Foo+  (+  )+where
+ data/examples/module-header/multiline-empty.hs view
@@ -0,0 +1,2 @@+module Foo (+           ) where
+ data/examples/module-header/multiline-out.hs view
@@ -0,0 +1,6 @@+module Foo+  ( foo,+    bar,+    baz,+  )+where
+ data/examples/module-header/multiline-with-comments-out.hs view
@@ -0,0 +1,22 @@+{-# 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/multiline-with-comments.hs view
@@ -0,0 +1,21 @@+-- | Header.++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}++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/multiline.hs view
@@ -0,0 +1,2 @@+module Foo (+  foo, bar, baz) where
+ data/examples/module-header/multiline2-out.hs view
@@ -0,0 +1,6 @@+module Foo+  ( foo,+    bar,+    baz,+  )+where
+ data/examples/module-header/multiline2.hs view
@@ -0,0 +1,2 @@+module Foo (+  foo, bar, baz) where
+ data/examples/module-header/named-section-out.hs view
@@ -0,0 +1,13 @@+module Magic+  ( -- * Something+    -- $explanation++    -- ** Another level+    foo,+    bar,+  )+where++-- $explanation+--+-- Here it goes.
+ data/examples/module-header/named-section.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-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/preceding-comment-with-haddock.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-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-out.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env stack++{-# LANGUAGE OverloadedStrings #-}++main = pure ()
+ data/examples/module-header/shebang-with-pragmas.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env stack++{-# LANGUAGE OverloadedStrings #-}++main = pure ()
+ data/examples/module-header/shebang.hs view
@@ -0,0 +1,6 @@+#! /usr/bin/env runhaskell++import Prelude++main :: IO ()+main = putStrLn "hello world"
+ data/examples/module-header/simple-out.hs view
@@ -0,0 +1,1 @@+module Main where
+ data/examples/module-header/simple-with-comments-out.hs view
@@ -0,0 +1,4 @@+-- | Here we go.+module Main where++-- Wow.
+ data/examples/module-header/simple-with-comments.hs view
@@ -0,0 +1,5 @@+-- | Here we go.++module Main where++-- Wow.
+ data/examples/module-header/simple.hs view
@@ -0,0 +1,1 @@+module Main where
+ data/examples/module-header/singleline-empty-out.hs view
@@ -0,0 +1,2 @@+-- | This demonstrates a BUG.+module Foo () where
+ data/examples/module-header/singleline-empty.hs view
@@ -0,0 +1,2 @@+-- | This demonstrates a BUG.+module Foo () where
+ data/examples/module-header/singleline-out.hs view
@@ -0,0 +1,1 @@+module Foo (foo, bar, baz) where
+ data/examples/module-header/singleline.hs view
@@ -0,0 +1,1 @@+module Foo ( foo, bar, baz ) where
+ data/examples/module-header/stack-header-0-out.hs view
@@ -0,0 +1,7 @@+-- stack runhaskell++{-# LANGUAGE OverloadedStrings #-}++main = return ()++-- stack runhaskell
+ data/examples/module-header/stack-header-0.hs view
@@ -0,0 +1,4 @@+-- stack runhaskell+{-# LANGUAGE OverloadedStrings #-}+main = return ()+-- stack runhaskell
+ data/examples/module-header/stack-header-1-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-1.hs view
@@ -0,0 +1,5 @@+#!/usr/bin/env stack+-- stack runhaskell+{-# LANGUAGE OverloadedStrings #-}+main = return ()+-- stack runhaskell
+ data/examples/module-header/stack-header-2-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/stack-header-2.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-list-multiline-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-list-multiline.hs view
@@ -0,0 +1,8 @@+module Test {-# DEPRECATED ["This module is deprecated.",+  "Please use OtherModule instead."+ ]#-}+  ( foo+  , bar+  , baz+  )+where
+ data/examples/module-header/warning-pragma-multiline-out.hs view
@@ -0,0 +1,6 @@+module Test+  {-# DEPRECATED "This module is unstable" #-}+  (foo, bar, baz)+where++import Blah
+ data/examples/module-header/warning-pragma-multiline.hs view
@@ -0,0 +1,4 @@+module Test {-# DEPRECATED "This module is unstable" #-}+  (foo, bar, baz) where++import Blah
+ data/examples/module-header/warning-pragma-out.hs view
@@ -0,0 +1,5 @@+module Test+  {-# WARNING+    "This module is very internal"+    #-}+where
+ data/examples/module-header/warning-pragma-singleton-list-out.hs view
@@ -0,0 +1,1 @@+module Test {-# WARNING "There's only one line here." #-} where
+ data/examples/module-header/warning-pragma-singleton-list.hs view
@@ -0,0 +1,1 @@+module Test {-# WArnING ["There's only one line here."]     #-} where
+ data/examples/module-header/warning-pragma.hs view
@@ -0,0 +1,2 @@+module Test {-# WARNING "This module is very internal"+  #-} where
+ data/examples/other/argument-comment-out.hs view
@@ -0,0 +1,17 @@+foo ::+  -- | Documentation+  Int ->+  Bool+foo _ = True++foo ::+  Foo a =>+  -- | Foo+  Int ->+  Int++foo ::+  Foo a =>+  -- | Foo+  Int ->+  Int
+ data/examples/other/argument-comment.hs view
@@ -0,0 +1,13 @@+foo+  :: Int -- ^ Documentation+  -> Bool+foo _ = True++foo :: Foo a+  => Int -- ^ Foo+  -> Int++foo+  :: Foo a+  => Int -- ^ Foo+  -> Int
+ data/examples/other/ascii-out.hs view
@@ -0,0 +1,9 @@+{- -----------------------------------+  < What about ASCII art in comments? >+   -----------------------------------+          \   ^__^+           \  (oo)\_______+              (__)\       )\/\+                  ||----w |+                  ||     ||+-}
+ data/examples/other/ascii.hs view
@@ -0,0 +1,9 @@+{- -----------------------------------+  < What about ASCII art in comments? >+   -----------------------------------+          \   ^__^+           \  (oo)\_______+              (__)\       )\/\+                  ||----w |+                  ||     ||+-}
+ data/examples/other/comment-after-preceding-haddock-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-after-preceding-haddock.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-out.hs view
@@ -0,0 +1,9 @@+class Foo a where+  -- | Foo.+  foo ::+    Int ->+    -- | Something+    a++  -- | Bar.+  bar :: a
+ data/examples/other/comment-alignment.hs view
@@ -0,0 +1,11 @@+class Foo a where++  -- | Foo.++  foo+    :: Int+    -> a -- ^ Something++  -- | Bar.++  bar :: a
+ data/examples/other/comment-before-hanging-out.hs view
@@ -0,0 +1,5 @@+x = Just+  -- comment+  do+    foo+    bar
+ data/examples/other/comment-before-hanging.hs view
@@ -0,0 +1,5 @@+x = Just+  -- comment+  do+    foo+    bar
+ data/examples/other/comment-following-preceding-gap-out.hs view
@@ -0,0 +1,6 @@+foo = bar+  where+    baz = return (quux) -- Foo++    -- Bar+    meme = gege
+ data/examples/other/comment-following-preceding-gap.hs view
@@ -0,0 +1,6 @@+foo = bar+  where+    baz = return (quux) -- Foo++    -- Bar+    meme = gege
+ data/examples/other/comment-inside-construct-out.hs view
@@ -0,0 +1,8 @@+xs =+  [ outer list item,+    [ inner list first item,+      inner list second item+      -- inner list last item commented+    ],+    outer list item+  ]
+ data/examples/other/comment-inside-construct.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-out.hs view
@@ -0,0 +1,7 @@+foo ::+  -- | start index+  Int ->+  -- | length+  Int ->+  t a ->+  t a
+ data/examples/other/comment-multiline-after.hs view
@@ -0,0 +1,1 @@+foo :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a
+ data/examples/other/comment-style-transform-out.hs view
@@ -0,0 +1,17 @@+-- |+-- 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.hs view
@@ -0,0 +1,22 @@+{-|+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-two-blocks-out.hs view
@@ -0,0 +1,8 @@+newNames :: [(String, String)]+newNames =+  let (*) = flip (,)+   in [ "Control" * "Monad"+  -- Foo++  -- Bar+      ]
+ data/examples/other/comment-two-blocks.hs view
@@ -0,0 +1,9 @@+newNames :: [(String, String)]+newNames = let (*) = flip (,) in+    ["Control" * "Monad"++    -- Foo++    -- Bar++    ]
+ data/examples/other/consequetive-pipe-comments-out.hs view
@@ -0,0 +1,7 @@+module Main where++-- | Foo.++-- | Bar.+bar :: Int+bar = 5
+ data/examples/other/consequetive-pipe-comments.hs view
@@ -0,0 +1,8 @@+module Main where++-- | Foo.++-- | Bar.++bar :: Int+bar = 5
+ data/examples/other/empty-forall-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-forall.hs view
@@ -0,0 +1,17 @@+-- 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"+  forall. r a = ()+#-}
+ data/examples/other/empty-haddock-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- |+foo :: Int+foo = 5
+ data/examples/other/empty-haddock.hs view
@@ -0,0 +1,6 @@+module Main where++-- |++foo :: Int+foo = 5
+ data/examples/other/following-comment-last-0-out.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Another datatype...+data D'+-- ^ ...with two docstrings.
+ data/examples/other/following-comment-last-0.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Another datatype...+data D'+-- ^ ...with two docstrings.
+ data/examples/other/following-comment-last-1-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-1.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-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-2.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-out.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Another datatype...+data D'+-- ^ ...with two docstrings.+-- even on second line
+ data/examples/other/following-comment-last-3.hs view
@@ -0,0 +1,6 @@+module Main where++-- | Another datatype...+data D'+-- ^ ...with two docstrings.+-- even on second line
+ data/examples/other/haddock-sections-out.hs view
@@ -0,0 +1,7 @@+-- $weird #anchor#+--+-- Section 1++-- $normal+--+-- Section 2
+ data/examples/other/haddock-sections.hs view
@@ -0,0 +1,7 @@+-- $weird #anchor#+--+-- Section 1++-- $normal+--+-- Section 2
+ data/examples/other/inline-comment-0-out.hs view
@@ -0,0 +1,3 @@+x = ({-a-} b, c)++y = ({-a-} b)
+ data/examples/other/inline-comment-0.hs view
@@ -0,0 +1,3 @@+x = ({-a-}b, c)++y = ({-a-}b)
+ data/examples/other/inline-comment-1-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/inline-comment-1.hs view
@@ -0,0 +1,9 @@+showPs env ((n, _, Let _ t v):bs)+    = "  " ++ show n ++ " : " +++      showEnv env ({- normalise ctxt env -} t) ++ "   =   " +++      showEnv env ({- normalise ctxt env -} v) +++      "\n" ++ showPs env bs+showPs env ((n, _, b):bs)+    = "  " ++ show n ++ " : " +++      showEnv env ({- normalise ctxt env -} (binderTy b)) +++      "\n" ++ showPs env bs
+ data/examples/other/merging-comments-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/merging-comments.hs view
@@ -0,0 +1,9 @@+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-out.hs view
@@ -0,0 +1,6 @@+{-+   And so here we have a+     multiline comment.++   Indeed.+-}
+ data/examples/other/multiline-comments-reindent.hs view
@@ -0,0 +1,6 @@+              {-+                 And so here we have a+                   multiline comment.++                 Indeed.+              -}
+ data/examples/other/multiline-forall-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/multiline-forall.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE RankNTypes, PolyKinds, GADTs, 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-out.hs view
@@ -0,0 +1,9 @@+module A where++a =+  b+    [ f+    {-,++                                       -}+    ]
+ data/examples/other/multiple-blank-line-comment.hs view
@@ -0,0 +1,10 @@+module A where++a =+  b+    [ f+ {-,+++                                    -}+    ]
+ data/examples/other/overly-indented-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/overly-indented.hs view
@@ -0,0 +1,10 @@+tagCloudField :: String+               -- ^ Destination key+               -> Double+               -- ^ Smallest font size, in percent+               -> Double+               -- ^ Biggest font size, in percent+               -> Tags+               -- ^ Input tags+               -> Context a+               -- ^ Context
+ data/examples/other/pragma-comments-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-comments.hs view
@@ -0,0 +1,11 @@+-- | Header comment.++{-# LANGUAGE OverloadedStrings #-}++-- Avoid warning produced by TH.+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}++-- TODO This extension is probably too dangerous, remove it.+{-# LANGUAGE RecordWildCards #-}++module Foo () where
+ data/examples/other/pragma-no-header-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ViewPatterns #-}
+ data/examples/other/pragma-no-header.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGuagE ViewPatterns #-}+{-# language DataKinds, LambdaCase #-}
+ data/examples/other/pragma-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-sorting-out.hs view
@@ -0,0 +1,11 @@+{-# 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/pragma-sorting.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE NondecreasingIndentation #-}+-- This gap is necessary for stylish Haskell not to re-arrange+-- NoMonoLocalBinds before TypeFamilies+{-# LANGUAGE NoMonoLocalBinds    #-}++module Foo (+   bar+  ) where
+ data/examples/other/pragma.hs view
@@ -0,0 +1,13 @@+-- | Header comment.++{-# LANGUAGE LambdaCase #-}+{-#LANGuagE ViewPatterns #-}+{-# LANGUAGE OverloadedStrings#-}+{-# OPTIONS_GHC -Wall -Werror #-}+{-# language DataKinds, LambdaCase #-}+{-# OPTIONS_HADDOCK   prune, show-extensions #-}+{-# OPTIONS_GHC -O2 -H 300    #-}+{-# language IncoherentInstances+           , AllowAmbiguousTypes #-}++module Foo () where
+ data/examples/other/trailing-whitespace-out.hs view
@@ -0,0 +1,7 @@+-- Here is a comment with trailing whitespace.+foo = 5++{- Block comment with trailing whitespace.+   Bo.+  -}+bar = 6
+ data/examples/other/trailing-whitespace.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
@@ -0,0 +1,183 @@+cabal-version:   1.18+name:            fourmolu+version:         0.0.6.0+license:         BSD3+license-file:    LICENSE.md+maintainer:      Matt Parsons <parsonsmatt@gmail.com>+tested-with:     ghc ==8.6.5 ghc ==8.8.3 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+description:     A formatter for Haskell source code.+category:        Development, Formatting+build-type:      Simple+data-files:+    data/examples/declaration/annotation/*.hs+    data/examples/declaration/class/*.hs+    data/examples/declaration/data/*.hs+    data/examples/declaration/data/gadt/*.hs+    data/examples/declaration/default/*.hs+    data/examples/declaration/deriving/*.hs+    data/examples/declaration/foreign/*.hs+    data/examples/declaration/instance/*.hs+    data/examples/declaration/rewrite-rule/*.hs+    data/examples/declaration/role-annotation/*.hs+    data/examples/declaration/signature/complete/*.hs+    data/examples/declaration/signature/fixity/*.hs+    data/examples/declaration/signature/inline/*.hs+    data/examples/declaration/signature/minimal/*.hs+    data/examples/declaration/signature/pattern/*.hs+    data/examples/declaration/signature/set-cost-centre/*.hs+    data/examples/declaration/signature/specialize/*.hs+    data/examples/declaration/signature/type/*.hs+    data/examples/declaration/splice/*.hs+    data/examples/declaration/type-families/closed-type-family/*.hs+    data/examples/declaration/type-families/data-family/*.hs+    data/examples/declaration/type-families/type-family/*.hs+    data/examples/declaration/type-synonyms/*.hs+    data/examples/declaration/type/*.hs+    data/examples/declaration/value/function/*.hs+    data/examples/declaration/value/function/arrow/*.hs+    data/examples/declaration/value/function/comprehension/*.hs+    data/examples/declaration/value/function/do/*.hs+    data/examples/declaration/value/function/infix/*.hs+    data/examples/declaration/value/function/pattern/*.hs+    data/examples/declaration/value/other/*.hs+    data/examples/declaration/value/pattern-synonyms/*.hs+    data/examples/declaration/warning/*.hs+    data/examples/import/*.hs+    data/examples/module-header/*.hs+    data/examples/other/*.hs++extra-doc-files:+    CONTRIBUTING.md+    CHANGELOG.md+    DESIGN.md+    README.md++source-repository head+    type:     git+    location: https://github.com/parsonsmatt/fourmolu.git++flag dev+    description: Turn on development settings.+    default:     False+    manual:      True++library+    exposed-modules:+        Ormolu+        Ormolu.Config+        Ormolu.Diff+        Ormolu.Exception+        Ormolu.Imports+        Ormolu.Parser+        Ormolu.Parser.Anns+        Ormolu.Parser.CommentStream+        Ormolu.Parser.Pragma+        Ormolu.Parser.Result+        Ormolu.Parser.Shebang+        Ormolu.Printer+        Ormolu.Printer.Combinators+        Ormolu.Printer.Comments+        Ormolu.Printer.Internal+        Ormolu.Printer.Meat.Common+        Ormolu.Printer.Meat.Declaration+        Ormolu.Printer.Meat.Declaration.Annotation+        Ormolu.Printer.Meat.Declaration.Class+        Ormolu.Printer.Meat.Declaration.Data+        Ormolu.Printer.Meat.Declaration.Default+        Ormolu.Printer.Meat.Declaration.Foreign+        Ormolu.Printer.Meat.Declaration.Instance+        Ormolu.Printer.Meat.Declaration.RoleAnnotation+        Ormolu.Printer.Meat.Declaration.Rule+        Ormolu.Printer.Meat.Declaration.Signature+        Ormolu.Printer.Meat.Declaration.Splice+        Ormolu.Printer.Meat.Declaration.Type+        Ormolu.Printer.Meat.Declaration.TypeFamily+        Ormolu.Printer.Meat.Declaration.Value+        Ormolu.Printer.Meat.Declaration.Warning+        Ormolu.Printer.Meat.ImportExport+        Ormolu.Printer.Meat.Module+        Ormolu.Printer.Meat.Pragma+        Ormolu.Printer.Meat.Type+        Ormolu.Printer.Operators+        Ormolu.Printer.SpanStream+        Ormolu.Processing.Common+        Ormolu.Processing.Cpp+        Ormolu.Processing.Postprocess+        Ormolu.Processing.Preprocess+        Ormolu.Utils++    hs-source-dirs:   src+    other-modules:+        GHC+        GHC.DynFlags++    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        bytestring >=0.2 && <0.11,+        containers >=0.5 && <0.7,+        dlist >=0.8 && <0.9,+        exceptions >=0.6 && <0.11,+        ghc-lib-parser >=8.10 && <8.11,+        mtl >=2.0 && <3.0,+        syb >=0.7 && <0.8,+        text >=0.2 && <1.3++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wcompat -Wincomplete-record-updates+            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+            -Wno-missing-home-modules++    else+        ghc-options: -O2 -Wall++executable fourmolu+    main-is:          Main.hs+    hs-source-dirs:   app+    other-modules:    Paths_fourmolu+    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        ghc-lib-parser >=8.10 && <8.11,+        gitrev >=1.3 && <1.4,+        optparse-applicative >=0.14 && <0.16,+        fourmolu -any,+        text >=0.2 && <1.3++    if flag(dev)+        ghc-options:+            -Wall -Werror -Wcompat -Wincomplete-record-updates+            -Wincomplete-uni-patterns -Wnoncanonical-monad-instances++    else+        ghc-options: -O2 -Wall -rtsopts++test-suite tests+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    build-tools:      hspec-discover >=2.0 && <3.0+    hs-source-dirs:   tests+    other-modules:+        Ormolu.Parser.PragmaSpec+        Ormolu.PrinterSpec++    default-language: Haskell2010+    build-depends:+        base >=4.12 && <5.0,+        containers >=0.5 && <0.7,+        filepath >=1.2 && <1.5,+        hspec >=2.0 && <3.0,+        fourmolu -any,+        path >=0.6 && <0.8,+        path-io >=1.4.2 && <2.0,+        text >=0.2 && <1.3++    if flag(dev)+        ghc-options: -Wall -Werror++    else+        ghc-options: -O2 -Wall
+ src/GHC.hs view
@@ -0,0 +1,12 @@+module GHC+  ( module X,+  )+where++import ApiAnnotation as X+import BasicTypes as X+import GHC.Hs as X+import GHC.Hs.Instances as X ()+import Module as X+import RdrName as X+import SrcLoc as X
+ src/GHC/DynFlags.hs view
@@ -0,0 +1,49 @@+{-# OPTIONS_GHC -Wno-missing-fields #-}++-- Modified from ghc-lib-api-ext.++module GHC.DynFlags+  ( baseDynFlags,+  )+where++import Config+import DynFlags+import Fingerprint+import GHC.Platform+import ToolSettings++fakeSettings :: Settings+fakeSettings =+  Settings+    { sGhcNameVersion =+        GhcNameVersion+          { ghcNameVersion_programName = "ghc",+            ghcNameVersion_projectVersion = cProjectVersion+          },+      sFileSettings = FileSettings {},+      sTargetPlatform =+        Platform+          { platformWordSize = PW8,+            platformMini =+              PlatformMini+                { platformMini_arch = ArchUnknown,+                  platformMini_os = OSUnknown+                },+            platformUnregisterised = True+          },+      sPlatformMisc = PlatformMisc {},+      sPlatformConstants =+        PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8},+      sToolSettings =+        ToolSettings+          { toolSettings_opt_P_fingerprint = fingerprint0,+            toolSettings_pgm_F = ""+          }+    }++fakeLlvmConfig :: LlvmConfig+fakeLlvmConfig = LlvmConfig [] []++baseDynFlags :: DynFlags+baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig
+ src/Ormolu.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE BangPatterns #-}++-- | A formatter for Haskell source code.+module Ormolu+  ( ormolu,+    ormoluFile,+    ormoluStdin,+    Config (..),+    RegionIndices (..),+    defaultConfig,+    DynOption (..),+    OrmoluException (..),+    withPrettyOrmoluExceptions,+  )+where++import qualified CmdLineParser as GHC+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class (MonadIO (..))+import Data.Text (Text)+import qualified Data.Text as T+import Debug.Trace+import Ormolu.Config+import Ormolu.Diff+import Ormolu.Exception+import Ormolu.Parser+import Ormolu.Parser.Result+import Ormolu.Printer+import Ormolu.Utils (showOutputable)+import qualified SrcLoc as GHC++-- | Format a 'String', return formatted version as 'Text'.+--+-- The function+--+--     * Takes 'String' because that's what GHC parser accepts.+--     * Needs 'IO' because some functions from GHC that are necessary to+--       setup parsing context require 'IO'. There should be no visible+--       side-effects though.+--     * Takes file name just to use it in parse error messages.+--     * Throws 'OrmoluException'.+ormolu ::+  MonadIO m =>+  -- | Ormolu configuration+  Config RegionIndices ->+  -- | Location of source file+  FilePath ->+  -- | Input to format+  String ->+  m Text+ormolu cfgWithIndices path str = do+  let totalLines = length (lines str)+      cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices+  (warnings, result0) <-+    parseModule' cfg OrmoluParsingFailed path str+  when (cfgDebug cfg) $ do+    traceM "warnings:\n"+    traceM (concatMap showWarn warnings)+    traceM (prettyPrintParseResult result0)+  -- We're forcing 'txt' here because otherwise errors (such as messages+  -- about not-yet-supported functionality) will be thrown later when we try+  -- to parse the rendered code back, inside of GHC monad wrapper which will+  -- lead to error messages presenting the exceptions as GHC bugs.+  let !txt = printModule result0+  when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do+    let pathRendered = path ++ "<rendered>"+    -- Parse the result of pretty-printing again and make sure that AST+    -- is the same as AST of original snippet module span positions.+    (_, result1) <-+      parseModule'+        cfg+        OrmoluOutputParsingFailed+        pathRendered+        (T.unpack txt)+    unless (cfgUnsafe cfg) $+      case diffParseResult result0 result1 of+        Same -> return ()+        Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss)+    -- Try re-formatting the formatted result to check if we get exactly+    -- the same output.+    when (cfgCheckIdempotence cfg) $+      let txt2 = printModule result1+       in case diffText txt txt2 pathRendered of+            Nothing -> return ()+            Just (loc, l, r) ->+              liftIO $+                throwIO (OrmoluNonIdempotentOutput loc l r)+  return txt++-- | Load a file and format it. The file stays intact and the rendered+-- version is returned as 'Text'.+--+-- > ormoluFile cfg path =+-- >   liftIO (readFile path) >>= ormolu cfg path+ormoluFile ::+  MonadIO m =>+  -- | Ormolu configuration+  Config RegionIndices ->+  -- | Location of source file+  FilePath ->+  -- | Resulting rendition+  m Text+ormoluFile cfg path =+  liftIO (readFile path) >>= ormolu cfg path++-- | Read input from stdin and format it.+--+-- > ormoluStdin cfg =+-- >   liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"+ormoluStdin ::+  MonadIO m =>+  -- | Ormolu configuration+  Config RegionIndices ->+  -- | Resulting rendition+  m Text+ormoluStdin cfg =+  liftIO getContents >>= ormolu cfg "<stdin>"++----------------------------------------------------------------------------+-- Helpers++-- | A wrapper around 'parseModule'.+parseModule' ::+  MonadIO m =>+  -- | Ormolu configuration+  Config RegionDeltas ->+  -- | How to obtain 'OrmoluException' to throw when parsing fails+  (GHC.SrcSpan -> String -> OrmoluException) ->+  -- | File name to use in errors+  FilePath ->+  -- | Actual input for the parser+  String ->+  m ([GHC.Warn], ParseResult)+parseModule' cfg mkException path str = do+  (warnings, r) <- parseModule cfg path str+  case r of+    Left (spn, err) -> liftIO $ throwIO (mkException spn err)+    Right x -> return (warnings, x)++-- | Pretty-print a 'GHC.Warn'.+showWarn :: GHC.Warn -> String+showWarn (GHC.Warn reason l) =+  unlines+    [ showOutputable reason,+      showOutputable l+    ]
+ src/Ormolu/Config.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE RecordWildCards #-}++-- | Configuration options used by the tool.+module Ormolu.Config+  ( Config (..),+    RegionIndices (..),+    RegionDeltas (..),+    defaultConfig,+    regionIndicesToDeltas,+    DynOption (..),+    dynOptionToLocatedStr,+  )+where++import qualified SrcLoc as GHC++-- | Ormolu configuration.+data Config region = Config+  { -- | Dynamic options to pass to GHC parser+    cfgDynOptions :: ![DynOption],+    -- | Do formatting faster but without automatic detection of defects+    cfgUnsafe :: !Bool,+    -- | Output information useful for debugging+    cfgDebug :: !Bool,+    -- | Checks if re-formatting the result is idempotent+    cfgCheckIdempotence :: !Bool,+    -- | Region selection+    cfgRegion :: !region+  }+  deriving (Eq, Show, Functor)++-- | Region selection as the combination of start and end line numbers.+data RegionIndices = RegionIndices+  { -- | Start line of the region to format+    regionStartLine :: !(Maybe Int),+    -- | End line of the region to format+    regionEndLine :: !(Maybe Int)+  }+  deriving (Eq, Show)++-- | Region selection as the length of the literal prefix and the literal+-- suffix.+data RegionDeltas = RegionDeltas+  { -- | Prefix length in number of lines+    regionPrefixLength :: !Int,+    -- | Suffix length in number of lines+    regionSuffixLength :: !Int+  }+  deriving (Eq, Show)++-- | Default @'Config' 'RegionIndices'@.+defaultConfig :: Config RegionIndices+defaultConfig =+  Config+    { cfgDynOptions = [],+      cfgUnsafe = False,+      cfgDebug = False,+      cfgCheckIdempotence = False,+      cfgRegion =+        RegionIndices+          { regionStartLine = Nothing,+            regionEndLine = Nothing+          }+    }++-- | Convert 'RegionIndices' into 'RegionDeltas'.+regionIndicesToDeltas ::+  -- | Total number of lines in the input+  Int ->+  -- | Region indices+  RegionIndices ->+  -- | Region deltas+  RegionDeltas+regionIndicesToDeltas total RegionIndices {..} =+  RegionDeltas+    { regionPrefixLength = maybe 0 (subtract 1) regionStartLine,+      regionSuffixLength = maybe 0 (total -) regionEndLine+    }++-- | A wrapper for dynamic options.+newtype DynOption = DynOption+  { unDynOption :: String+  }+  deriving (Eq, Ord, Show)++-- | Convert 'DynOption' to @'GHC.Located' 'String'@.+dynOptionToLocatedStr :: DynOption -> GHC.Located String+dynOptionToLocatedStr (DynOption o) = GHC.L GHC.noSrcSpan o
+ src/Ormolu/Diff.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE RankNTypes #-}++-- | Diffing GHC ASTs modulo span positions.+module Ormolu.Diff+  ( Diff (..),+    diffParseResult,+    diffText,+  )+where++import Data.ByteString (ByteString)+import Data.Generics+import Data.Text (Text)+import qualified Data.Text as T+import qualified FastString as GHC+import GHC+import Ormolu.Imports (sortImports)+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Result+import Ormolu.Utils++-- | Result of comparing two 'ParseResult's.+data Diff+  = -- | Two parse results are the same+    Same+  | -- | Two parse results differ+    Different [SrcSpan]++instance Semigroup Diff where+  Same <> a = a+  a <> Same = a+  Different xs <> Different ys = Different (xs ++ ys)++instance Monoid Diff where+  mempty = Same++-- | Return 'Diff' of two 'ParseResult's.+diffParseResult :: ParseResult -> ParseResult -> Diff+diffParseResult+  ParseResult+    { prCommentStream = cstream0,+      prParsedSource = hs0+    }+  ParseResult+    { prCommentStream = cstream1,+      prParsedSource = hs1+    } =+    matchIgnoringSrcSpans cstream0 cstream1+      <> matchIgnoringSrcSpans+        hs0 {hsmodImports = sortImports (hsmodImports hs0)}+        hs1 {hsmodImports = sortImports (hsmodImports hs1)}++-- | Compare two values for equality disregarding differences in 'SrcSpan's+-- and the ordering of import lists.+matchIgnoringSrcSpans :: Data a => a -> a -> Diff+matchIgnoringSrcSpans = genericQuery+  where+    genericQuery :: GenericQ (GenericQ Diff)+    genericQuery x y+      -- 'ByteString' implements 'Data' instance manually and does not+      -- implement 'toConstr', so we have to deal with it in a special way.+      | Just x' <- cast x,+        Just y' <- cast y =+        if x' == (y' :: ByteString)+          then Same+          else Different []+      | typeOf x == typeOf y,+        toConstr x == toConstr y =+        mconcat $+          gzipWithQ+            ( genericQuery+                `extQ` srcSpanEq+                `extQ` commentEq+                `extQ` sourceTextEq+                `extQ` hsDocStringEq+                `extQ` importDeclQualifiedStyleEq+                `ext2Q` forLocated+            )+            x+            y+      | otherwise = Different []+    srcSpanEq :: SrcSpan -> GenericQ Diff+    srcSpanEq _ _ = Same+    commentEq :: Comment -> GenericQ Diff+    commentEq (Comment _ x) d =+      case cast d :: Maybe Comment of+        Nothing -> Different []+        Just (Comment _ y) ->+          if x == y+            then Same+            else Different []+    sourceTextEq :: SourceText -> GenericQ Diff+    sourceTextEq _ _ = Same+    importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff+    importDeclQualifiedStyleEq d0 d1' =+      case (d0, cast d1' :: Maybe ImportDeclQualifiedStyle) of+        (x, Just x') | x == x' -> Same+        (QualifiedPre, Just QualifiedPost) -> Same+        (QualifiedPost, Just QualifiedPre) -> Same+        _ -> Different []+    hsDocStringEq :: HsDocString -> GenericQ Diff+    hsDocStringEq str0 str1' =+      case cast str1' :: Maybe HsDocString of+        Nothing -> Different []+        Just str1 ->+          if splitDocString str0 == splitDocString str1+            then Same+            else Different []+    forLocated ::+      (Data e0, Data e1) =>+      GenLocated e0 e1 ->+      GenericQ Diff+    forLocated x@(L mspn _) y =+      maybe id appendSpan (cast mspn) (genericQuery x y)+    appendSpan :: SrcSpan -> Diff -> Diff+    appendSpan s (Different ss) | fresh && helpful = Different (s : ss)+      where+        fresh = not $ any (`isSubspanOf` s) ss+        helpful = isGoodSrcSpan s+    appendSpan _ d = d++-- | Diff two texts and return the location they start to differ, alongside+-- with excerpts around that location.+diffText ::+  -- | Text before+  Text ->+  -- | Text after+  Text ->+  -- | Path to use to construct 'GHC.RealSrcLoc'+  FilePath ->+  Maybe (GHC.RealSrcLoc, Text, Text)+diffText left right fp =+  case go (0, 0, 0) left right of+    Nothing -> Nothing+    Just (row, col, loc) ->+      Just+        ( GHC.mkRealSrcLoc (GHC.mkFastString fp) row col,+          getSpan loc left,+          getSpan loc right+        )+  where+    go (row, col, loc) t1 t2 =+      case (T.uncons t1, T.uncons t2) of+        -- both text empty, all good+        (Nothing, Nothing) ->+          Nothing+        -- first chars are the same, adjust position and recurse+        (Just (c1, r1), Just (c2, r2))+          | c1 == c2 ->+            let (row', col', loc') =+                  if c1 == '\n'+                    then (row + 1, 0, loc + 1)+                    else (row, col + 1, loc + 1)+             in go (row', col', loc') r1 r2+        -- something is different, return the position+        _ ->+          Just (row, col, loc)+    getSpan loc = T.take 20 . T.drop (loc - 10)
+ src/Ormolu/Exception.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE LambdaCase #-}++-- | 'OrmoluException' type and surrounding definitions.+module Ormolu.Exception+  ( OrmoluException (..),+    withPrettyOrmoluExceptions,+  )+where++import Control.Exception+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified GHC+import Ormolu.Utils (showOutputable)+import qualified Outputable as GHC+import System.Exit (ExitCode (..), exitWith)+import System.IO++-- | Ormolu exception representing all cases when Ormolu can fail.+data OrmoluException+  = -- | Parsing of original source code failed+    OrmoluParsingFailed GHC.SrcSpan String+  | -- | Parsing of formatted source code failed+    OrmoluOutputParsingFailed GHC.SrcSpan String+  | -- | Original and resulting ASTs differ+    OrmoluASTDiffers FilePath [GHC.SrcSpan]+  | -- | Formatted source code is not idempotent+    OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text+  | -- | Some GHC options were not recognized+    OrmoluUnrecognizedOpts (NonEmpty String)+  deriving (Eq, Show)++instance Exception OrmoluException where+  displayException = \case+    OrmoluParsingFailed s e ->+      showParsingErr "The GHC parser (in Haddock mode) failed:" s [e]+    OrmoluOutputParsingFailed s e ->+      showParsingErr "Parsing of formatted code failed:" s [e]+        ++ "Please, consider reporting the bug.\n"+    OrmoluASTDiffers path ss ->+      unlines $+        [ "AST of input and AST of formatted code differ."+        ]+          ++ fmap+            withIndent+            ( case fmap (\s -> "at " ++ showOutputable s) ss of+                [] -> ["in " ++ path]+                xs -> xs+            )+          ++ ["Please, consider reporting the bug."]+    OrmoluNonIdempotentOutput loc left right ->+      showParsingErr+        "Formatting is not idempotent:"+        loc+        ["before: " ++ show left, "after:  " ++ show right]+        ++ "Please, consider reporting the bug.\n"+    OrmoluUnrecognizedOpts opts ->+      unlines+        [ "The following GHC options were not recognized:",+          (withIndent . unwords . NE.toList) opts+        ]++-- | Inside this wrapper 'OrmoluException' will be caught and displayed+-- nicely using 'displayException'.+withPrettyOrmoluExceptions ::+  -- | Action that may throw the exception+  IO a ->+  IO a+withPrettyOrmoluExceptions m = m `catch` h+  where+    h :: OrmoluException -> IO a+    h e = do+      hPutStrLn stderr (displayException e)+      exitWith . ExitFailure $+        case e of+          -- Error code 1 is for 'error' or 'notImplemented'+          -- 2 used to be for erroring out on CPP+          OrmoluParsingFailed {} -> 3+          OrmoluOutputParsingFailed {} -> 4+          OrmoluASTDiffers {} -> 5+          OrmoluNonIdempotentOutput {} -> 6+          OrmoluUnrecognizedOpts {} -> 7++----------------------------------------------------------------------------+-- Helpers++-- | Show a parse error.+showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String+showParsingErr msg spn err =+  unlines $+    [ msg,+      withIndent (showOutputable spn)+    ]+      ++ map withIndent err++-- | Indent with 2 spaces for readability.+withIndent :: String -> String+withIndent txt = "  " ++ txt
+ src/Ormolu/Imports.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++-- | Manipulations on import lists.+module Ormolu.Imports+  ( sortImports,+  )+where++import Data.Bifunctor+import Data.Function (on)+import Data.Generics (gcompare)+import Data.List (sortBy)+import GHC hiding (GhcPs, IE)+import GHC.Hs.Extension+import GHC.Hs.ImpExp (IE (..))+import Ormolu.Utils (notImplemented)++-- | 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)+  where+    sortImportLists :: ImportDecl GhcPs -> ImportDecl GhcPs+    sortImportLists = \case+      ImportDecl {..} ->+        ImportDecl+          { ideclHiding = second (fmap sortLies) <$> ideclHiding,+            ..+          }+      XImportDecl x -> noExtCon x++-- | 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+  where+    n0 = unLoc (ideclName m0)+    n1 = unLoc (ideclName m1)+    isPrelude = (== "Prelude") . moduleNameString++-- | Sort located import or export.+sortLies :: [LIE GhcPs] -> [LIE GhcPs]+sortLies = sortBy (compareIE `on` unLoc) . fmap (fmap sortThings)++-- | 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++-- | Compare two located imports or exports.+compareIE :: IE GhcPs -> IE GhcPs -> Ordering+compareIE = compareIewn `on` getIewn++-- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@.+getIewn :: IE GhcPs -> IEWrappedName RdrName+getIewn = \case+  IEVar NoExtField x -> unLoc x+  IEThingAbs NoExtField x -> unLoc x+  IEThingAll NoExtField x -> unLoc x+  IEThingWith NoExtField x _ _ _ -> unLoc x+  IEModuleContents NoExtField _ -> notImplemented "IEModuleContents"+  IEGroup NoExtField _ _ -> notImplemented "IEGroup"+  IEDoc NoExtField _ -> notImplemented "IEDoc"+  IEDocNamed NoExtField _ -> notImplemented "IEDocNamed"+  XIE x -> noExtCon x++-- | Compare two @'IEWrapppedName' 'RdrName'@ things.+compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering+compareIewn (IEName x) (IEName y) = unLoc x `compare` 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 _) (IEType _) = LT+compareIewn (IEType _) (IEName _) = GT+compareIewn (IEType _) (IEPattern _) = GT+compareIewn (IEType x) (IEType y) = unLoc x `compare` unLoc y
+ src/Ormolu/Parser.hs view
@@ -0,0 +1,217 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Parser for Haskell source code.+module Ormolu.Parser+  ( parseModule,+    manualExts,+  )+where++import Bag (bagToList)+import qualified CmdLineParser as GHC+import Control.Exception+import Control.Monad.IO.Class+import qualified Data.List as L+import qualified Data.List.NonEmpty as NE+import Data.Ord (Down (Down))+import qualified Data.Text as T+import DynFlags as GHC+import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan)+import qualified FastString as GHC+import GHC hiding (IE, UnicodeSyntax)+import GHC.DynFlags (baseDynFlags)+import GHC.LanguageExtensions.Type (Extension (..))+import qualified HeaderInfo as GHC+import qualified HscTypes as GHC+import qualified Lexer as GHC+import Ormolu.Config+import Ormolu.Exception+import Ormolu.Parser.Anns+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Result+import Ormolu.Processing.Preprocess (preprocess)+import Ormolu.Utils (incSpanLine)+import qualified Panic as GHC+import qualified Parser as GHC+import qualified StringBuffer as GHC++-- | Parse a complete module from string.+parseModule ::+  MonadIO m =>+  -- | Ormolu configuration+  Config RegionDeltas ->+  -- | File name (only for source location annotations)+  FilePath ->+  -- | Input for parser+  String ->+  m+    ( [GHC.Warn],+      Either (SrcSpan, String) ParseResult+    )+parseModule Config {..} path rawInput = liftIO $ do+  let (literalPrefix, input, literalSuffix, extraComments) =+        preprocess path rawInput cfgRegion+  -- It's important that 'setDefaultExts' is done before+  -- 'parsePragmasIntoDynFlags', because otherwise we might enable an+  -- extension that was explicitly disabled in the file.+  let baseFlags =+        GHC.setGeneralFlag'+          GHC.Opt_Haddock+          (setDefaultExts baseDynFlags)+      extraOpts = dynOptionToLocatedStr <$> cfgDynOptions+  (warnings, dynFlags) <-+    parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case+      Right res -> pure res+      Left err ->+        let loc =+              mkSrcSpan+                (mkSrcLoc (GHC.mkFastString path) 1 1)+                (mkSrcLoc (GHC.mkFastString path) 1 1)+         in throwIO (OrmoluParsingFailed loc err)+  let useRecordDot =+        "record-dot-preprocessor" == pgm_F dynFlags+          || any+            (("RecordDotPreprocessor" ==) . moduleNameString)+            (pluginModNames dynFlags)+      pStateErrors = \pstate ->+        let errs = bagToList $ GHC.getErrorMessages pstate dynFlags+            fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion)+         in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of+              [] -> Nothing+              err : _ ->+                -- Show instance returns a short error message+                Just (fixupErrSpan (errMsgSpan err), show err)+      r = case runParser GHC.parseModule dynFlags path input of+        GHC.PFailed pstate ->+          case pStateErrors pstate of+            Just err -> Left err+            Nothing -> error "PFailed does not have an error"+        GHC.POk pstate (L _ hsModule) ->+          case pStateErrors pstate of+            -- Some parse errors (pattern/arrow syntax in expr context)+            -- do not cause a parse error, but they are replaced with "_"+            -- by the parser and the modified AST is propagated to the+            -- later stages; but we fail in those cases.+            Just err -> Left err+            Nothing ->+              let (stackHeader, shebangs, pragmas, comments) =+                    mkCommentStream input extraComments pstate+               in Right+                    ParseResult+                      { prParsedSource = hsModule,+                        prAnns = mkAnns pstate,+                        prStackHeader = stackHeader,+                        prShebangs = shebangs,+                        prPragmas = pragmas,+                        prCommentStream = comments,+                        prUseRecordDot = useRecordDot,+                        prImportQualifiedPost =+                          GHC.xopt ImportQualifiedPost dynFlags,+                        prLiteralPrefix = T.pack literalPrefix,+                        prLiteralSuffix = T.pack literalSuffix+                      }+  return (warnings, r)++-- | Enable all language extensions that we think should be enabled by+-- default for ease of use.+setDefaultExts :: DynFlags -> DynFlags+setDefaultExts flags = L.foldl' xopt_set flags autoExts+  where+    autoExts = allExts L.\\ manualExts+    allExts = [minBound .. maxBound]++-- | Extensions that are not enabled automatically and should be activated+-- by user.+manualExts :: [Extension]+manualExts =+  [ Arrows, -- steals proc+    Cpp, -- forbidden+    BangPatterns, -- makes certain patterns with ! fail+    PatternSynonyms, -- steals the pattern keyword+    RecursiveDo, -- steals the rec keyword+    StaticPointers, -- steals static keyword+    TransformListComp, -- steals the group keyword+    UnboxedTuples, -- breaks (#) lens operator+    MagicHash, -- screws {-# these things #-}+    TypeApplications, -- steals (@) operator on some cases+    AlternativeLayoutRule,+    AlternativeLayoutRuleTransitional,+    MonadComprehensions,+    UnboxedSums,+    UnicodeSyntax, -- gives special meanings to operators like (→)+    TemplateHaskellQuotes, -- enables TH subset of quasi-quotes, this+    -- apparently interferes with QuasiQuotes in+    -- weird ways+    ImportQualifiedPost -- affects how Ormolu renders imports, so the+    -- decision of enabling this style is left to the user+  ]++-- | Run a 'GHC.P' computation.+runParser ::+  -- | Computation to run+  GHC.P a ->+  -- | Dynamic flags+  GHC.DynFlags ->+  -- | Module path+  FilePath ->+  -- | Module contents+  String ->+  -- | Parse result+  GHC.ParseResult a+runParser parser flags filename input = GHC.unP parser parseState+  where+    location = GHC.mkRealSrcLoc (GHC.mkFastString filename) 1 1+    buffer = GHC.stringToStringBuffer input+    parseState = GHC.mkPState flags buffer location++-- | Wrap GHC's 'Severity' to add 'Ord' instance.+newtype SeverityOrd = SeverityOrd Severity++instance Eq SeverityOrd where+  s1 == s2 = compare s1 s2 == EQ++instance Ord SeverityOrd where+  compare (SeverityOrd s1) (SeverityOrd s2) =+    compare (f s1) (f s2)+    where+      f :: Severity -> Int+      f SevOutput = 1+      f SevFatal = 2+      f SevInteractive = 3+      f SevDump = 4+      f SevInfo = 5+      f SevWarning = 6+      f SevError = 7++----------------------------------------------------------------------------+-- Helpers taken from HLint++parsePragmasIntoDynFlags ::+  -- | Pre-set 'DynFlags'+  DynFlags ->+  -- | Extra options (provided by user)+  [Located String] ->+  -- | File name (only for source location annotations)+  FilePath ->+  -- | Input for parser+  String ->+  IO (Either String ([GHC.Warn], DynFlags))+parsePragmasIntoDynFlags flags extraOpts filepath str =+  catchErrors $ do+    let opts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath+    (flags', leftovers, warnings) <-+      parseDynamicFilePragma flags (opts <> extraOpts)+    case NE.nonEmpty leftovers of+      Nothing -> return ()+      Just unrecognizedOpts ->+        throwIO (OrmoluUnrecognizedOpts (unLoc <$> unrecognizedOpts))+    let flags'' = flags' `gopt_set` Opt_KeepRawTokenStream+    return $ Right (warnings, flags'')+  where+    catchErrors act =+      GHC.handleGhcException+        reportErr+        (GHC.handleSourceError reportErr act)+    reportErr e = return $ Left (show e)
+ src/Ormolu/Parser/Anns.hs view
@@ -0,0 +1,46 @@+-- | Ormolu-specific representation of GHC annotations.+module Ormolu.Parser.Anns+  ( Anns (..),+    emptyAnns,+    mkAnns,+    lookupAnns,+  )+where++import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Maybe (mapMaybe)+import qualified GHC+import qualified Lexer as GHC+import SrcLoc++-- | Ormolu-specific representation of GHC annotations.+newtype Anns = Anns (Map RealSrcSpan [GHC.AnnKeywordId])+  deriving (Eq)++-- | Empty 'Anns'.+emptyAnns :: Anns+emptyAnns = Anns M.empty++-- | Create 'Anns' from 'GHC.PState'.+mkAnns ::+  GHC.PState ->+  Anns+mkAnns pstate =+  Anns $+    M.fromListWith (++) (mapMaybe f (GHC.annotations pstate))+  where+    f ((spn, kid), _) =+      case spn of+        RealSrcSpan rspn -> Just (rspn, [kid])+        UnhelpfulSpan _ -> Nothing++-- | Lookup 'GHC.AnnKeywordId's corresponding to a given 'SrcSpan'.+lookupAnns ::+  -- | Span to lookup with+  SrcSpan ->+  -- | Collection of annotations+  Anns ->+  [GHC.AnnKeywordId]+lookupAnns (RealSrcSpan rspn) (Anns m) = M.findWithDefault [] rspn m+lookupAnns (UnhelpfulSpan _) _ = []
+ src/Ormolu/Parser/CommentStream.hs view
@@ -0,0 +1,209 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}++-- | Functions for working with comment stream.+module Ormolu.Parser.CommentStream+  ( -- * Comment stream+    CommentStream (..),+    mkCommentStream,+    showCommentStream,++    -- * Comment+    Comment (..),+    unComment,+    hasAtomsBefore,+    isMultilineComment,+  )+where++import Data.Char (isSpace)+import Data.Data (Data)+import qualified Data.List as L+import Data.List.NonEmpty (NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe (mapMaybe)+import qualified GHC+import qualified Lexer as GHC+import Ormolu.Parser.Pragma+import Ormolu.Parser.Shebang+import Ormolu.Utils (showOutputable)+import SrcLoc++----------------------------------------------------------------------------+-- Comment stream++-- | A stream of 'RealLocated' 'Comment's in ascending order with respect to+-- beginning of corresponding spans.+newtype CommentStream = CommentStream [RealLocated Comment]+  deriving (Eq, Data, Semigroup, Monoid)++-- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are+-- removed from the 'CommentStream'. Shebangs are only extracted from the+-- comments that come from the first argument.+mkCommentStream ::+  -- | Original input+  String ->+  -- | Extra comments to include+  [Located String] ->+  -- | Parser state to use for comment extraction+  GHC.PState ->+  -- | Stack header, shebangs, pragmas, and comment stream+  ( Maybe (RealLocated Comment),+    [Shebang],+    [([RealLocated Comment], Pragma)],+    CommentStream+  )+mkCommentStream input extraComments pstate =+  ( mstackHeader,+    shebangs,+    pragmas,+    CommentStream comments+  )+  where+    (comments, pragmas) = extractPragmas input rawComments1+    (rawComments1, mstackHeader) = extractStackHeader rawComments0+    rawComments0 =+      L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $+        otherExtraComments+          ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)+          ++ concatMap+            (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)+            (GHC.annotations_comments pstate)+    (shebangs, otherExtraComments) = extractShebangs extraComments++-- | Pretty-print a 'CommentStream'.+showCommentStream :: CommentStream -> String+showCommentStream (CommentStream xs) =+  unlines $+    showComment <$> xs+  where+    showComment (GHC.L l str) = showOutputable l ++ " " ++ show str++----------------------------------------------------------------------------+-- Comment++-- | A wrapper for a single comment. The 'Bool' indicates whether there were+-- atoms before beginning of the comment in the original input. The+-- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or+-- just single item\/line otherwise.+data Comment = Comment Bool (NonEmpty String)+  deriving (Eq, Show, Data)++-- | Normalize comment string. Sometimes one multi-line comment is turned+-- into several lines for subsequent outputting with correct indentation for+-- each line.+mkComment ::+  -- | Lines of original input with their indices+  [(Int, String)] ->+  -- | Raw comment string+  RealLocated String ->+  -- | Remaining lines of original input and the constructed 'Comment'+  ([(Int, String)], RealLocated Comment)+mkComment ls (L l s) = (ls', comment)+  where+    comment =+      L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $+        if "{-" `L.isPrefixOf` s+          then case NE.nonEmpty (lines s) of+            Nothing -> s :| []+            Just (x :| xs) ->+              let getIndent y =+                    if all isSpace y+                      then startIndent+                      else length (takeWhile isSpace y)+                  n = minimum (startIndent : fmap getIndent xs)+               in x :| (drop n <$> xs)+          else s :| []+    (atomsBefore, ls') =+      case dropWhile ((< commentLine) . fst) ls of+        [] -> (False, [])+        ((_, i) : ls'') ->+          case take 2 (dropWhile isSpace i) of+            "--" -> (False, ls'')+            "{-" -> (False, ls'')+            _ -> (True, ls'')+    dropTrailing = L.dropWhileEnd isSpace+    startIndent = srcSpanStartCol l - 1+    commentLine = srcSpanStartLine l++-- | Get a collection of lines from a 'Comment'.+unComment :: Comment -> NonEmpty String+unComment (Comment _ xs) = xs++-- | Check whether the 'Comment' had some non-whitespace atoms in front of+-- it in the original input.+hasAtomsBefore :: Comment -> Bool+hasAtomsBefore (Comment atomsBefore _) = atomsBefore++-- | Is this comment multiline-style?+isMultilineComment :: Comment -> Bool+isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x++----------------------------------------------------------------------------+-- Helpers++-- | Detect and extract stack header if it is present.+extractStackHeader ::+  [RealLocated String] ->+  ([RealLocated String], Maybe (RealLocated Comment))+extractStackHeader = \case+  [] -> ([], Nothing)+  (x : xs) ->+    let comment = snd (mkComment [] x)+     in if isStackHeader (unRealSrcSpan comment)+          then (xs, Just comment)+          else (x : xs, Nothing)+  where+    isStackHeader (Comment _ (x :| _)) =+      "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x)++-- | Extract pragmas and their associated comments.+extractPragmas ::+  String ->+  [RealLocated String] ->+  ([RealLocated Comment], [([RealLocated Comment], Pragma)])+extractPragmas input = go initialLs id id+  where+    initialLs = zip [1 ..] (lines input)+    go ls csSoFar pragmasSoFar = \case+      [] -> (csSoFar [], pragmasSoFar [])+      (x : xs) ->+        case parsePragma (unRealSrcSpan x) of+          Nothing ->+            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++-- | Get a 'String' from 'GHC.AnnotationComment'.+unAnnotationComment :: GHC.AnnotationComment -> Maybe String+unAnnotationComment = \case+  GHC.AnnDocCommentNext _ -> Nothing -- @-- |@+  GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@+  GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@+  GHC.AnnDocSection _ _ -> Nothing -- @-- *@+  GHC.AnnDocOptions s -> Just s+  GHC.AnnLineComment s -> Just s+  GHC.AnnBlockComment s -> Just s++liftMaybe :: Located (Maybe a) -> Maybe (Located a)+liftMaybe = \case+  L _ Nothing -> Nothing+  L l (Just a) -> Just (L l a)++toRealSpan :: Located a -> Maybe (RealLocated a)+toRealSpan (L (RealSrcSpan l) a) = Just (L l a)+toRealSpan _ = Nothing++-- | Remove consecutive blank lines.+removeConseqBlanks :: NonEmpty String -> NonEmpty String+removeConseqBlanks (x :| xs) = x :| go (null x) id xs+  where+    go seenBlank acc = \case+      [] -> acc []+      (y : ys) ->+        if seenBlank && null y+          then go True acc ys+          else go (null y) (acc . (y :)) ys
+ src/Ormolu/Parser/Pragma.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | A module for parsing of pragmas from comments.+module Ormolu.Parser.Pragma+  ( Pragma (..),+    parsePragma,+  )+where++import Control.Monad+import Data.Char (isSpace, toLower)+import qualified Data.List as L+import qualified EnumSet as ES+import FastString (mkFastString, unpackFS)+import qualified Lexer as L+import Module (ComponentId (..), newSimpleUnitId)+import SrcLoc+import StringBuffer++-- | Ormolu's representation of pragmas.+data Pragma+  = -- | Language pragma+    PragmaLanguage [String]+  | -- | GHC options pragma+    PragmaOptionsGHC String+  | -- | Haddock options pragma+    PragmaOptionsHaddock String+  deriving (Show, Eq)++-- | Extract a pragma from a comment if possible, or return 'Nothing'+-- otherwise.+parsePragma ::+  -- | Comment to try to parse+  String ->+  Maybe Pragma+parsePragma input = do+  inputNoPrefix <- L.stripPrefix "{-#" input+  guard ("#-}" `L.isSuffixOf` input)+  let contents = take (length inputNoPrefix - 3) inputNoPrefix+      (pragmaName, cs) = (break isSpace . dropWhile isSpace) contents+  case toLower <$> pragmaName of+    "language" -> PragmaLanguage <$> parseExtensions cs+    "options_ghc" -> Just $ PragmaOptionsGHC (trimSpaces cs)+    "options_haddock" -> Just $ PragmaOptionsHaddock (trimSpaces cs)+    _ -> Nothing+  where+    trimSpaces :: String -> String+    trimSpaces = L.dropWhileEnd isSpace . dropWhile isSpace++-- | Assuming the input consists of a series of tokens from a language+-- pragma, return the set of enabled extensions.+parseExtensions :: String -> Maybe [String]+parseExtensions str = tokenize str >>= go+  where+    go = \case+      [L.ITconid ext] -> return [unpackFS ext]+      (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs+      _ -> Nothing++-- | Tokenize a given input using GHC's lexer.+tokenize :: String -> Maybe [L.Token]+tokenize input =+  case L.unP pLexer parseState of+    L.PFailed {} -> Nothing+    L.POk _ x -> Just x+  where+    location = mkRealSrcLoc (mkFastString "") 1 1+    buffer = stringToStringBuffer input+    parseState = L.mkPStatePure parserFlags buffer location+    parserFlags =+      L.mkParserFlags'+        ES.empty+        ES.empty+        (newSimpleUnitId (ComponentId (mkFastString "")))+        True+        True+        True+        True++-- | Haskell lexer.+pLexer :: L.P [L.Token]+pLexer = go+  where+    go = do+      r <- L.lexer False return+      case unLoc r of+        L.ITeof -> return []+        x -> (x :) <$> go
+ src/Ormolu/Parser/Result.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE RecordWildCards #-}++-- | A type for result of parsing.+module Ormolu.Parser.Result+  ( ParseResult (..),+    prettyPrintParseResult,+  )+where++import Data.Text (Text)+import GHC+import Ormolu.Parser.Anns+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Pragma (Pragma)+import Ormolu.Parser.Shebang (Shebang)++-- | A collection of data that represents a parsed module in Ormolu.+data ParseResult = ParseResult+  { -- | 'ParsedSource' from GHC+    prParsedSource :: HsModule GhcPs,+    -- | Ormolu-specfic representation of annotations+    prAnns :: Anns,+    -- | Stack header+    prStackHeader :: Maybe (RealLocated Comment),+    -- | Shebangs found in the input+    prShebangs :: [Shebang],+    -- | Pragmas and the associated comments+    prPragmas :: [([RealLocated Comment], Pragma)],+    -- | Comment stream+    prCommentStream :: CommentStream,+    -- | Whether or not record dot syntax is enabled+    prUseRecordDot :: Bool,+    -- | Whether or not ImportQualifiedPost is enabled+    prImportQualifiedPost :: Bool,+    -- | Literal prefix+    prLiteralPrefix :: Text,+    -- | Literal suffix+    prLiteralSuffix :: Text+  }++-- | Pretty-print a 'ParseResult'.+prettyPrintParseResult :: ParseResult -> String+prettyPrintParseResult ParseResult {..} =+  unlines+    [ "parse result:",+      "  comment stream:",+      showCommentStream prCommentStream+      -- XXX extend as needed+    ]
+ src/Ormolu/Parser/Shebang.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- | A module for dealing with shebangs.+module Ormolu.Parser.Shebang+  ( Shebang (..),+    extractShebangs,+    isShebang,+  )+where++import Data.Data (Data)+import qualified Data.List as L+import SrcLoc++-- | A wrapper for a shebang.+newtype Shebang = Shebang (Located String)+  deriving (Eq, Data)++-- | Extract shebangs from the beginning of a comment stream.+extractShebangs :: [Located String] -> ([Shebang], [Located String])+extractShebangs comments = (Shebang <$> shebangs, rest)+  where+    (shebangs, rest) = span (isShebang . unLoc) comments++-- | Return 'True' if given 'String' is a shebang.+isShebang :: String -> Bool+isShebang str = "#!" `L.isPrefixOf` str
+ src/Ormolu/Printer.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE RecordWildCards #-}++-- | Pretty-printer for Haskell AST.+module Ormolu.Printer+  ( printModule,+  )+where++import Data.Text (Text)+import Ormolu.Parser.Result+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Module+import Ormolu.Printer.SpanStream+import Ormolu.Processing.Postprocess (postprocess)++-- | Render a module.+printModule ::+  -- | Result of parsing+  ParseResult ->+  -- | Resulting rendition+  Text+printModule ParseResult {..} =+  prLiteralPrefix <> region <> prLiteralSuffix+  where+    region =+      postprocess $+        runR+          ( p_hsModule+              prStackHeader+              prShebangs+              prPragmas+              prImportQualifiedPost+              prParsedSource+          )+          (mkSpanStream prParsedSource)+          prCommentStream+          prAnns+          prUseRecordDot
+ src/Ormolu/Printer/Combinators.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Printing combinators. The definitions here are presented in such an+-- order so you can just go through the Haddocks and by the end of the file+-- you should have a pretty good idea how to program rendering logic.+module Ormolu.Printer.Combinators+  ( -- * The 'R' monad+    R,+    runR,+    getAnns,+    getEnclosingSpan,++    -- * Combinators++    -- ** Basic+    txt,+    atom,+    space,+    newline,+    inci,+    located,+    located',+    switchLayout,+    Layout (..),+    vlayout,+    getLayout,+    breakpoint,+    breakpoint',++    -- ** Formatting lists+    sep,+    sepSemi,+    canUseBraces,+    useBraces,+    dontUseBraces,++    -- ** Wrapping+    BracketStyle (..),+    sitcc,+    backticks,+    banana,+    braces,+    brackets,+    parens,+    parensHash,+    pragmaBraces,+    pragma,++    -- ** Literals+    comma,+    equals,++    -- ** Stateful markers+    SpanMark (..),+    spanMarkSpan,+    HaddockStyle (..),+    setSpanMark,+    getSpanMark,+  )+where++import Control.Monad+import Data.List (intersperse)+import Data.Text (Text)+import Ormolu.Printer.Comments+import Ormolu.Printer.Internal+import SrcLoc++----------------------------------------------------------------------------+-- Basic++-- | 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+-- 'Located' wrapper, it should be “discharged” with a corresponding+-- 'located' invocation.+located ::+  -- | Thing to enter+  Located a ->+  -- | How to render inner value+  (a -> R ()) ->+  R ()+located (L (UnhelpfulSpan _) a) f = f a+located (L (RealSrcSpan l) a) f = do+  spitPrecedingComments l+  withEnclosingSpan l $+    switchLayout [RealSrcSpan l] (f a)+  spitFollowingComments l++-- | A version of 'located' with arguments flipped.+located' ::+  -- | How to render inner value+  (a -> R ()) ->+  -- | Thing to enter+  Located a ->+  R ()+located' = flip located++-- | Set layout according to combination of given 'SrcSpan's for a given.+-- Use this only when you need to set layout based on e.g. combined span of+-- several elements when there is no corresponding 'Located' wrapper+-- provided by GHC AST. It is relatively rare that this one is needed.+--+-- Given empty list this function will set layout to single line.+switchLayout ::+  -- | Span that controls layout+  [SrcSpan] ->+  -- | Computation to run with changed layout+  R () ->+  R ()+switchLayout spans' = enterLayout (spansLayout spans')++-- | Which layout combined spans result in?+spansLayout :: [SrcSpan] -> Layout+spansLayout = \case+  [] -> SingleLine+  (x : xs) ->+    if isOneLineSpan (foldr combineSrcSpans x xs)+      then SingleLine+      else MultiLine++-- | Insert a space if enclosing layout is single-line, or newline if it's+-- multiline.+--+-- > breakpoint = vlayout space newline+breakpoint :: R ()+breakpoint = vlayout space newline++-- | Similar to 'breakpoint' but outputs nothing in case of single-line+-- layout.+--+-- > breakpoint' = vlayout (return ()) newline+breakpoint' :: R ()+breakpoint' = vlayout (return ()) newline++----------------------------------------------------------------------------+-- Formatting lists++-- | Render a collection of elements inserting a separator between them.+sep ::+  -- | Separator+  R () ->+  -- | How to render an element+  (a -> R ()) ->+  -- | Elements to render+  [a] ->+  R ()+sep s f xs = sequence_ (intersperse s (f <$> xs))++-- | Render a collection of elements layout-sensitively using given printer,+-- inserting semicolons if necessary and respecting 'useBraces' and+-- 'dontUseBraces' combinators.+--+-- > useBraces $ sepSemi txt ["foo", "bar"]+-- >   == vlayout (txt "{ foo; bar }") (txt "foo\nbar")+--+-- > dontUseBraces $ sepSemi txt ["foo", "bar"]+-- >   == vlayout (txt "foo; bar") (txt "foo\nbar")+sepSemi ::+  -- | How to render an element+  (a -> R ()) ->+  -- | Elements to render+  [a] ->+  R ()+sepSemi f xs = vlayout singleLine multiLine+  where+    singleLine = do+      ub <- canUseBraces+      case xs of+        [] -> when ub $ txt "{}"+        xs' ->+          if ub+            then do+              txt "{ "+              sep (txt "; ") (dontUseBraces . f) xs'+              txt " }"+            else sep (txt "; ") f xs'+    multiLine =+      sep newline (dontUseBraces . f) xs++----------------------------------------------------------------------------+-- Wrapping++-- | 'BracketStyle' controlling how closing bracket is rendered.+data BracketStyle+  = -- | Normal+    N+  | -- | Shifted one level+    S++-- | Surround given entity by backticks.+backticks :: R () -> R ()+backticks m = do+  txt "`"+  m+  txt "`"++-- | Surround given entity by banana brackets (i.e., from arrow notation.)+banana :: R () -> R ()+banana = brackets_ True "(|" "|)" N++-- | Surround given entity by curly braces @{@ and  @}@.+braces :: BracketStyle -> R () -> R ()+braces = brackets_ False "{" "}"++-- | Surround given entity by square brackets @[@ and @]@.+brackets :: BracketStyle -> R () -> R ()+brackets = brackets_ False "[" "]"++-- | Surround given entity by parentheses @(@ and @)@.+parens :: BracketStyle -> R () -> R ()+parens = brackets_ False "(" ")"++-- | Surround given entity by @(# @ and @ #)@.+parensHash :: BracketStyle -> R () -> R ()+parensHash = brackets_ True "(#" "#)"++-- | Braces as used for pragmas: @{-#@ and @#-}@.+pragmaBraces :: R () -> R ()+pragmaBraces m = sitcc $ do+  txt "{-#"+  space+  m+  breakpoint+  inci (txt "#-}")++-- | Surround the body with a pragma name and 'pragmaBraces'.+pragma ::+  -- | Pragma text+  Text ->+  -- | Pragma body+  R () ->+  R ()+pragma pragmaText body = pragmaBraces $ do+  txt pragmaText+  breakpoint+  body++-- | A helper for defining wrappers like 'parens' and 'braces'.+brackets_ ::+  -- | Insert breakpoints around brackets+  Bool ->+  -- | Opening bracket+  Text ->+  -- | Closing bracket+  Text ->+  -- | Bracket style+  BracketStyle ->+  -- | Inner expression+  R () ->+  R ()+brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)+  where+    singleLine = do+      txt open+      when needBreaks space+      m+      when needBreaks space+      txt close+    multiLine = do+      txt open+      if needBreaks+        then newline >> inci m+        else space >> sitcc m+      newline+      case style of+        N -> txt close+        S -> inci (txt close)++----------------------------------------------------------------------------+-- Literals++-- | Print @,@.+comma :: R ()+comma = txt ","++-- | Print @=@. Do not use @'txt' "="@.+equals :: R ()+equals = interferingTxt "="
+ src/Ormolu/Printer/Comments.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Helpers for formatting of comments. This is low-level code, use+-- "Ormolu.Printer.Combinators" unless you know what you are doing.+module Ormolu.Printer.Comments+  ( spitPrecedingComments,+    spitFollowingComments,+    spitRemainingComments,+    spitCommentNow,+    spitCommentPending,+  )+where++import Control.Monad+import qualified Data.List.NonEmpty as NE+import Data.Maybe (listToMaybe)+import qualified Data.Text as T+import Ormolu.Parser.CommentStream+import Ormolu.Printer.Internal+import SrcLoc++----------------------------------------------------------------------------+-- Top-level++-- | Output all preceding comments for an element at given location.+spitPrecedingComments ::+  -- | Span of the element to attach comments to+  RealSrcSpan ->+  R ()+spitPrecedingComments ref = do+  gotSome <- handleCommentSeries (spitPrecedingComment ref)+  when gotSome $ do+    lastMark <- getSpanMark+    -- Insert a blank line between the preceding comments and the thing+    -- after them if there was a blank line in the input.+    when (needsNewlineBefore ref lastMark) newline++-- | Output all comments following an element at given location.+spitFollowingComments ::+  -- | Span of the element to attach comments to+  RealSrcSpan ->+  R ()+spitFollowingComments ref = do+  trimSpanStream ref+  void $ handleCommentSeries (spitFollowingComment ref)++-- | Output all remaining comments in the comment stream.+spitRemainingComments :: R ()+spitRemainingComments = do+  -- Make sure we have a blank a line between the last definition and the+  -- trailing comments.+  newline+  void $ handleCommentSeries spitRemainingComment++----------------------------------------------------------------------------+-- Single-comment functions++-- | Output a single preceding comment for an element at given location.+spitPrecedingComment ::+  -- | Span of the element to attach comments to+  RealSrcSpan ->+  -- | Are we done?+  R Bool+spitPrecedingComment ref = do+  mlastMark <- getSpanMark+  let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref+  withPoppedComment p $ \l comment -> do+    lineSpans <- thisLineSpans+    let thisCommentLine = srcLocLine (realSrcSpanStart l)+        needsNewline =+          case listToMaybe lineSpans of+            Nothing -> False+            Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine+    when (needsNewline || needsNewlineBefore l mlastMark) newline+    spitCommentNow l comment+    if theSameLinePre l ref+      then space+      else newline++-- | Output a comment that follows element at given location immediately on+-- the same line, if there is any.+spitFollowingComment ::+  -- | AST element to attach comments to+  RealSrcSpan ->+  -- | Are we done?+  R Bool+spitFollowingComment ref = do+  mlastMark <- getSpanMark+  mnSpn <- nextEltSpan+  -- Get first enclosing span that is not equal to reference span, i.e. it's+  -- truly something enclosing the AST element.+  meSpn <- getEnclosingSpan (/= ref)+  withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment ->+    if theSameLinePost l ref+      then+        if isMultilineComment comment+          then space >> spitCommentNow l comment+          else spitCommentPending OnTheSameLine l comment+      else do+        when (needsNewlineBefore l mlastMark) $+          registerPendingCommentLine OnNextLine ""+        spitCommentPending OnNextLine l comment++-- | Output a single remaining comment from the comment stream.+spitRemainingComment ::+  -- | Are we done?+  R Bool+spitRemainingComment = do+  mlastMark <- getSpanMark+  withPoppedComment (const True) $ \l comment -> do+    when (needsNewlineBefore l mlastMark) newline+    spitCommentNow l comment+    newline++----------------------------------------------------------------------------+-- Helpers++-- | Output series of comments.+handleCommentSeries ::+  -- | Given location of previous comment, output the next comment+  -- returning 'True' if we're done+  R Bool ->+  -- | Whether we printed any comments+  R Bool+handleCommentSeries f = go False+  where+    go gotSome = do+      done <- f+      if done+        then return gotSome+        else go True++-- | Try to pop a comment using given predicate and if there is a comment+-- matching the predicate, print it out.+withPoppedComment ::+  -- | Comment predicate+  (RealLocated Comment -> Bool) ->+  -- | Printing function+  (RealSrcSpan -> Comment -> R ()) ->+  -- | Are we done?+  R Bool+withPoppedComment p f = do+  r <- popComment p+  case r of+    Nothing -> return True+    Just (L l comment) -> False <$ f l comment++-- | Determine if we need to insert a newline between current comment and+-- last printed comment.+needsNewlineBefore ::+  -- | Current comment span+  RealSrcSpan ->+  -- | Last printed comment span+  Maybe SpanMark ->+  Bool+needsNewlineBefore l mlastMark =+  case spanMarkSpan <$> mlastMark of+    Nothing -> False+    Just lastMark ->+      srcSpanStartLine l > srcSpanEndLine lastMark + 1++-- | Is the preceding comment and AST element are on the same line?+theSameLinePre ::+  -- | Current comment span+  RealSrcSpan ->+  -- | AST element location+  RealSrcSpan ->+  Bool+theSameLinePre l ref =+  srcSpanEndLine l == srcSpanStartLine ref++-- | Is the following comment and AST element are on the same line?+theSameLinePost ::+  -- | Current comment span+  RealSrcSpan ->+  -- | AST element location+  RealSrcSpan ->+  Bool+theSameLinePost l ref =+  srcSpanStartLine l == srcSpanEndLine ref++-- | Determine if given comment follows AST element.+commentFollowsElt ::+  -- | Location of AST element+  RealSrcSpan ->+  -- | Location of next AST element+  Maybe RealSrcSpan ->+  -- | Location of enclosing AST element+  Maybe RealSrcSpan ->+  -- | Location of last comment in the series+  Maybe SpanMark ->+  -- | Comment to test+  RealLocated Comment ->+  Bool+commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) =+  -- A comment follows a AST element if all 4 conditions are satisfied:+  goesAfter+    && logicallyFollows+    && noEltBetween+    && (continuation || lastInEnclosing || supersedesParentElt)+  where+    -- 1) The comment starts after end of the AST element:+    goesAfter =+      realSrcSpanStart l >= realSrcSpanEnd ref+    -- 2) The comment logically belongs to the element, four cases:+    logicallyFollows =+      theSameLinePost l ref -- a) it's on the same line+        || continuation -- b) it's a continuation of a comment block+        || lastInEnclosing -- c) it's the last element in the enclosing construct++    -- 3) There is no other AST element between this element and the comment:+    noEltBetween =+      case mnSpn of+        Nothing -> True+        Just nspn ->+          realSrcSpanStart nspn >= realSrcSpanEnd l+    -- 4) Less obvious: if column of comment is closer to the start of+    -- enclosing element, it probably related to that parent element, not to+    -- the current child element. This rule is important because otherwise+    -- all comments would end up assigned to closest inner elements, and+    -- parent elements won't have a chance to get any comments assigned to+    -- them. This is not OK because comments will get indented according to+    -- the AST elements they are attached to.+    --+    -- Skip this rule if the comment is a continuation of a comment block.+    supersedesParentElt =+      case meSpn of+        Nothing -> True+        Just espn ->+          let startColumn = srcLocCol . realSrcSpanStart+           in startColumn espn > startColumn ref+                || ( abs (startColumn espn - 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+           )+    lastInEnclosing =+      case meSpn of+        -- When there is no enclosing element, return false+        Nothing -> False+        -- When there is an enclosing element,+        Just espn ->+          let -- Make sure that the comment is inside the enclosing element+              insideParent = realSrcSpanEnd l <= realSrcSpanEnd espn+              -- And check if the next element is outside of the parent+              nextOutsideParent = case mnSpn of+                Nothing -> True+                Just nspn -> realSrcSpanEnd espn < realSrcSpanStart nspn+           in insideParent && nextOutsideParent++-- | Output a 'Comment' immediately. This is a low-level printing function.+spitCommentNow :: RealSrcSpan -> Comment -> R ()+spitCommentNow spn comment = do+  sitcc+    . sequence_+    . NE.intersperse newline+    . fmap (txt . T.pack)+    . unComment+    $ comment+  setSpanMark (CommentSpan spn)++-- | Output a 'Comment' at the end of correct line or after it depending on+-- 'CommentPosition'. Used for comments that may potentially follow on the+-- same line as something we just rendered, but not immediately after it.+spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R ()+spitCommentPending position spn comment = do+  let wrapper = case position of+        OnTheSameLine -> sitcc+        OnNextLine -> id+  wrapper+    . sequence_+    . NE.toList+    . fmap (registerPendingCommentLine position . T.pack)+    . unComment+    $ comment+  setSpanMark (CommentSpan spn)
+ src/Ormolu/Printer/Internal.hs view
@@ -0,0 +1,575 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}++-- | In most cases import "Ormolu.Printer.Combinators" instead, these+-- functions are the low-level building blocks and should not be used on+-- their own. The 'R' monad is re-exported from "Ormolu.Printer.Combinators"+-- as well.+module Ormolu.Printer.Internal+  ( -- * The 'R' monad+    R,+    runR,++    -- * Internal functions+    txt,+    interferingTxt,+    atom,+    space,+    newline,+    useRecordDot,+    inci,+    sitcc,+    Layout (..),+    enterLayout,+    vlayout,+    getLayout,++    -- * Helpers for braces+    useBraces,+    dontUseBraces,+    canUseBraces,++    -- * Special helpers for comment placement+    CommentPosition (..),+    registerPendingCommentLine,+    trimSpanStream,+    nextEltSpan,+    popComment,+    getEnclosingSpan,+    withEnclosingSpan,+    thisLineSpans,++    -- * Stateful markers+    SpanMark (..),+    spanMarkSpan,+    HaddockStyle (..),+    setSpanMark,+    getSpanMark,++    -- * Annotations+    getAnns,+  )+where++import Control.Monad.Reader+import Control.Monad.State.Strict+import Data.Bool (bool)+import Data.Coerce+import Data.Maybe (listToMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL+import Data.Text.Lazy.Builder+import GHC+import Ormolu.Parser.Anns+import Ormolu.Parser.CommentStream+import Ormolu.Printer.SpanStream+import Ormolu.Utils (showOutputable)+import Outputable (Outputable)++----------------------------------------------------------------------------+-- The 'R' monad++-- | The 'R' monad hosts combinators that allow us to describe how to render+-- AST.+newtype R a = R (ReaderT RC (State SC) a)+  deriving (Functor, Applicative, Monad)++-- | Reader context of 'R'. This should be used when we control rendering by+-- enclosing certain expressions with wrappers.+data RC = RC+  { -- | Indentation level, as the column index we need to start from after+    -- a newline if we break lines+    rcIndent :: !Int,+    -- | Current layout+    rcLayout :: Layout,+    -- | Spans of enclosing elements of AST+    rcEnclosingSpans :: [RealSrcSpan],+    -- | Collection of annotations+    rcAnns :: Anns,+    -- | Whether the last expression in the layout can use braces+    rcCanUseBraces :: Bool,+    -- | Whether the source could have used the record dot preprocessor+    rcUseRecDot :: Bool+  }++-- | State context of 'R'.+data SC = SC+  { -- | Index of the next column to render+    scColumn :: !Int,+    -- | Indentation level that was used for the current line+    scIndent :: !Int,+    -- | Rendered source code so far+    scBuilder :: Builder,+    -- | Span stream+    scSpanStream :: SpanStream,+    -- | Spans of atoms that have been printed on the current line so far+    scThisLineSpans :: [RealSrcSpan],+    -- | Comment stream+    scCommentStream :: CommentStream,+    -- | Pending comment lines (in reverse order) to be inserted before next+    -- newline, 'Int' is the indentation level+    scPendingComments :: ![(CommentPosition, Text)],+    -- | Whether to output a space before the next output+    scRequestedDelimiter :: !RequestedDelimiter,+    -- | An auxiliary marker for keeping track of last output element+    scSpanMark :: !(Maybe SpanMark)+  }++-- | Make sure next output is delimited by one of the following.+data RequestedDelimiter+  = -- | A space+    RequestedSpace+  | -- | A newline+    RequestedNewline+  | -- | Nothing+    RequestedNothing+  | -- | We just output a newline+    AfterNewline+  | -- | We haven't printed anything yet+    VeryBeginning+  deriving (Eq, Show)++-- | 'Layout' options.+data Layout+  = -- | Put everything on single line+    SingleLine+  | -- | Use multiple lines+    MultiLine+  deriving (Eq, Show)++-- | Modes for rendering of pending comments.+data CommentPosition+  = -- | Put the comment on the same line+    OnTheSameLine+  | -- | Put the comment on next line+    OnNextLine+  deriving (Eq, Show)++-- | Run an 'R' monad.+runR ::+  -- | Monad to run+  R () ->+  -- | Span stream+  SpanStream ->+  -- | Comment stream+  CommentStream ->+  -- | Annotations+  Anns ->+  -- | Use Record Dot Syntax+  Bool ->+  -- | Resulting rendition+  Text+runR (R m) sstream cstream anns recDot =+  TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc+  where+    rc =+      RC+        { rcIndent = 0,+          rcLayout = MultiLine,+          rcEnclosingSpans = [],+          rcAnns = anns,+          rcCanUseBraces = False,+          rcUseRecDot = recDot+        }+    sc =+      SC+        { scColumn = 0,+          scIndent = 0,+          scBuilder = mempty,+          scSpanStream = sstream,+          scThisLineSpans = [],+          scCommentStream = cstream,+          scPendingComments = [],+          scRequestedDelimiter = VeryBeginning,+          scSpanMark = Nothing+        }++----------------------------------------------------------------------------+-- Internal functions++-- | Type of the thing to output. Influences the primary low-level rendering+-- function 'spit'.+data SpitType+  = -- | Simple opaque text that breaks comment series.+    SimpleText+  | -- | Like 'SimpleText', but assume that when this text is inserted it+    -- will separate an 'Atom' and its pending comments, so insert an extra+    -- 'newline' in that case to force the pending comments and continue on+    -- a fresh line.+    InterferingText+  | -- | An atom that typically have span information in the AST and can+    -- have comments attached to it.+    Atom+  | -- | Used for rendering comment lines.+    CommentPart+  deriving (Show, Eq)++-- | Output a fixed 'Text' fragment. The argument may not contain any line+-- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like+-- keywords and pipes @|@ in functional dependencies.+--+-- To separate various bits of syntax with white space use 'space' instead+-- of @'txt' " "@. To output 'Outputable' Haskell entities like numbers use+-- 'atom'.+txt ::+  -- | 'Text' to output+  Text ->+  R ()+txt = spit SimpleText++-- |+interferingTxt ::+  -- | 'Text' to output+  Text ->+  R ()+interferingTxt = spit InterferingText++-- | Output 'Outputable' fragment of AST. This can be used to output numeric+-- literals and similar. Everything that doesn't have inner structure but+-- does have an 'Outputable' instance.+atom ::+  Outputable a =>+  a ->+  R ()+atom = spit Atom . T.pack . showOutputable++-- | Low-level non-public helper to define 'txt' and 'atom'.+spit ::+  -- | Type of the thing to spit+  SpitType ->+  -- | 'Text' to output+  Text ->+  R ()+spit stype text = do+  requestedDel <- R (gets scRequestedDelimiter)+  pendingComments <- R (gets scPendingComments)+  when (stype == InterferingText && not (null pendingComments)) newline+  case requestedDel of+    RequestedNewline -> do+      R . modify $ \sc ->+        sc+          { scRequestedDelimiter = RequestedNothing+          }+      case stype of+        CommentPart -> newlineRaw+        _ -> newline+    _ -> return ()+  R $ do+    i <- asks rcIndent+    c <- gets scColumn+    closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans+    let indentedTxt = spaces <> text+        spaces = T.replicate spacesN " "+        spacesN =+          if c == 0+            then i+            else bool 0 1 (requestedDel == RequestedSpace)+    modify $ \sc ->+      sc+        { scBuilder = scBuilder sc <> fromText indentedTxt,+          scColumn = scColumn sc + T.length indentedTxt,+          scIndent =+            if c == 0+              then i+              else scIndent sc,+          scThisLineSpans =+            let xs = scThisLineSpans sc+             in case stype of+                  Atom -> case closestEnclosing of+                    Nothing -> xs+                    Just x -> x : xs+                  _ -> xs,+          scRequestedDelimiter = RequestedNothing,+          scSpanMark =+            -- If there are pending comments, do not reset last comment+            -- location.+            if (stype == CommentPart) || (not . null . scPendingComments) sc+              then scSpanMark sc+              else Nothing+        }++-- | This primitive /does not/ necessarily output a space. It just ensures+-- that the next thing that will be printed on the same line will be+-- separated by a single space from the previous output. Using this+-- combinator twice results in at most one space.+--+-- In practice this design prevents trailing white space and makes it hard+-- to output more than one delimiting space in a row, which is what we+-- usually want.+space :: R ()+space = R . modify $ \sc ->+  sc+    { scRequestedDelimiter = case scRequestedDelimiter sc of+        RequestedNothing -> RequestedSpace+        other -> other+    }++-- | Output a newline. First time 'newline' is used after some non-'newline'+-- output it gets inserted immediately. Second use of 'newline' does not+-- output anything but makes sure that the next non-white space output will+-- be prefixed by a newline. Using 'newline' more than twice in a row has no+-- effect. Also, using 'newline' at the very beginning has no effect, this+-- is to avoid leading whitespace.+--+-- Similarly to 'space', this design prevents trailing newlines and makes it+-- hard to output more than one blank newline in a row.+newline :: R ()+newline = do+  indent <- R (gets scIndent)+  cs <- reverse <$> R (gets scPendingComments)+  case cs of+    [] -> newlineRaw+    ((position, _) : _) -> do+      case position of+        OnTheSameLine -> space+        OnNextLine -> newlineRaw+      R . forM_ cs $ \(_, text) ->+        let modRC rc =+              rc+                { rcIndent = indent+                }+            R m = do+              unless (T.null text) $+                spit CommentPart text+              newlineRaw+         in local modRC m+      R . modify $ \sc ->+        sc+          { scPendingComments = []+          }++-- | Low-level newline primitive. This one always just inserts a newline, no+-- hooks can be attached.+newlineRaw :: R ()+newlineRaw = R . modify $ \sc ->+  let requestedDel = scRequestedDelimiter sc+      builderSoFar = scBuilder sc+   in sc+        { scBuilder = case requestedDel of+            AfterNewline -> builderSoFar+            RequestedNewline -> builderSoFar+            VeryBeginning -> builderSoFar+            _ -> builderSoFar <> "\n",+          scColumn = 0,+          scIndent = 0,+          scThisLineSpans = [],+          scRequestedDelimiter = case scRequestedDelimiter sc of+            AfterNewline -> RequestedNewline+            RequestedNewline -> RequestedNewline+            VeryBeginning -> VeryBeginning+            _ -> AfterNewline+        }++-- | Return 'True' if we should print record dot syntax.+useRecordDot :: R Bool+useRecordDot = R (asks rcUseRecDot)++-- | Increase indentation level by one indentation step for the inner+-- computation. 'inci' should be used when a part of code must be more+-- indented relative to the parts outside of 'inci' in order for the output+-- 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) = R (local modRC m)+  where+    modRC rc =+      rc+        { rcIndent = rcIndent rc + indentStep+        }++-- | Set indentation level for the inner computation equal to current+-- column. This makes sure that the entire inner block is uniformly+-- \"shifted\" to the right.+sitcc :: R () -> R ()+sitcc (R m) = do+  requestedDel <- R (gets scRequestedDelimiter)+  i <- R (asks rcIndent)+  c <- R (gets scColumn)+  let modRC rc =+        rc+          { rcIndent = max i (c + bool 0 1 (requestedDel == RequestedSpace))+          }+  R (local modRC m)++-- | Set 'Layout' for internal computation.+enterLayout :: Layout -> R () -> R ()+enterLayout l (R m) = R (local modRC m)+  where+    modRC rc =+      rc+        { rcLayout = l+        }++-- | Do one or another thing depending on current 'Layout'.+vlayout ::+  -- | Single line+  R a ->+  -- | Multi line+  R a ->+  R a+vlayout sline mline = do+  l <- getLayout+  case l of+    SingleLine -> sline+    MultiLine -> mline++-- | Get current 'Layout'.+getLayout :: R Layout+getLayout = R (asks rcLayout)++----------------------------------------------------------------------------+-- Special helpers for comment placement++-- | Register a comment line for outputting. It will be inserted right+-- before next newline. When the comment goes after something else on the+-- same line, a space will be inserted between preceding text and the+-- comment when necessary.+registerPendingCommentLine ::+  -- | Comment position+  CommentPosition ->+  -- | 'Text' to output+  Text ->+  R ()+registerPendingCommentLine position text = R $ do+  modify $ \sc ->+    sc+      { scPendingComments = (position, text) : scPendingComments sc+      }++-- | Drop elements that begin before or at the same place as given+-- 'SrcSpan'.+trimSpanStream ::+  -- | Reference span+  RealSrcSpan ->+  R ()+trimSpanStream ref = do+  let leRef :: RealSrcSpan -> Bool+      leRef x = realSrcSpanStart x <= realSrcSpanStart ref+  R . modify $ \sc ->+    sc+      { scSpanStream = coerce (dropWhile leRef) (scSpanStream sc)+      }++-- | Get location of next element in AST.+nextEltSpan :: R (Maybe RealSrcSpan)+nextEltSpan = listToMaybe . coerce <$> R (gets scSpanStream)++-- | Pop a 'Comment' from the 'CommentStream' if given predicate is+-- satisfied and there are comments in the stream.+popComment ::+  (RealLocated Comment -> Bool) ->+  R (Maybe (RealLocated Comment))+popComment f = R $ do+  CommentStream cstream <- gets scCommentStream+  case cstream of+    [] -> return Nothing+    (x : xs) ->+      if f x+        then+          Just x+            <$ modify+              ( \sc ->+                  sc+                    { scCommentStream = CommentStream xs+                    }+              )+        else return Nothing++-- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate.+getEnclosingSpan ::+  -- | Predicate to use+  (RealSrcSpan -> Bool) ->+  R (Maybe RealSrcSpan)+getEnclosingSpan f =+  listToMaybe . filter f <$> R (asks rcEnclosingSpans)++-- | Set 'RealSrcSpan' of enclosing span for the given computation.+withEnclosingSpan :: RealSrcSpan -> R () -> R ()+withEnclosingSpan spn (R m) = R (local modRC m)+  where+    modRC rc =+      rc+        { rcEnclosingSpans = spn : rcEnclosingSpans rc+        }++-- | Get spans on this line so far.+thisLineSpans :: R [RealSrcSpan]+thisLineSpans = R (gets scThisLineSpans)++----------------------------------------------------------------------------+-- Stateful markers++-- | An auxiliary marker for keeping track of last output element.+data SpanMark+  = -- | Haddock comment+    HaddockSpan HaddockStyle RealSrcSpan+  | -- | Non-haddock comment+    CommentSpan RealSrcSpan+  | -- | A statement in a do-block and such span+    StatementSpan RealSrcSpan++-- | Project 'RealSrcSpan' from 'SpanMark'.+spanMarkSpan :: SpanMark -> RealSrcSpan+spanMarkSpan = \case+  HaddockSpan _ s -> s+  CommentSpan s -> s+  StatementSpan s -> s++-- | Haddock string style.+data HaddockStyle+  = -- | @-- |@+    Pipe+  | -- | @-- ^@+    Caret+  | -- | @-- *@+    Asterisk Int+  | -- | @-- $@+    Named String++-- | Set span of last output comment.+setSpanMark ::+  -- | Span mark to set+  SpanMark ->+  R ()+setSpanMark spnMark = R . modify $ \sc ->+  sc+    { scSpanMark = Just spnMark+    }++-- | Get span of last output comment.+getSpanMark :: R (Maybe SpanMark)+getSpanMark = R (gets scSpanMark)++----------------------------------------------------------------------------+-- Annotations++-- | For a given span return 'AnnKeywordId's associated with it.+getAnns ::+  SrcSpan ->+  R [AnnKeywordId]+getAnns spn = lookupAnns spn <$> R (asks rcAnns)++----------------------------------------------------------------------------+-- Helpers for braces++-- | Make the inner computation use braces around single-line layouts.+useBraces :: R () -> R ()+useBraces (R r) = R (local (\i -> i {rcCanUseBraces = True}) r)++-- | Make the inner computation omit braces around single-line layouts.+dontUseBraces :: R () -> R ()+dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r)++-- | Return 'True' if we can use braces in this context.+canUseBraces :: R Bool+canUseBraces = R (asks rcCanUseBraces)++----------------------------------------------------------------------------+-- Constants++-- | Indentation step.+indentStep :: Int+indentStep = 4
+ src/Ormolu/Printer/Meat/Common.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Rendering of commonly useful bits.+module Ormolu.Printer.Meat.Common+  ( FamilyStyle (..),+    p_hsmodName,+    p_ieWrappedName,+    p_rdrName,+    doesNotNeedExtraParens,+    p_qualName,+    p_infixDefHelper,+    p_hsDocString,+    p_hsDocName,+  )+where++import Control.Monad+import Data.List (isPrefixOf)+import qualified Data.Text as T+import GHC hiding (GhcPs, IE)+import Name (nameStableString)+import OccName (OccName (..))+import Ormolu.Printer.Combinators+import Ormolu.Utils++-- | Data and type family style.+data FamilyStyle+  = -- | Declarations in type classes+    Associated+  | -- | Top-level declarations+    Free++p_hsmodName :: ModuleName -> R ()+p_hsmodName mname = do+  txt "module"+  space+  atom mname++p_ieWrappedName :: IEWrappedName RdrName -> R ()+p_ieWrappedName = \case+  IEName x -> p_rdrName x+  IEPattern x -> do+    txt "pattern"+    space+    p_rdrName x+  IEType x -> do+    txt "type"+    space+    p_rdrName x++-- | Render a @'Located' 'RdrName'@.+p_rdrName :: Located RdrName -> R ()+p_rdrName l@(L spn _) = located l $ \x -> do+  ids <- getAnns spn+  let backticksWrapper =+        if AnnBackquote `elem` ids+          then backticks+          else id+      parensWrapper =+        if AnnOpenP `elem` ids+          then parens N+          else id+      singleQuoteWrapper =+        if AnnSimpleQuote `elem` ids+          then \y -> do+            txt "'"+            y+          else id+      m =+        case x of+          Unqual occName ->+            atom occName+          Qual mname occName ->+            p_qualName mname occName+          Orig _ occName ->+            -- This is used when GHC generates code that will be fed into+            -- the renamer (e.g. from deriving clauses), but where we want+            -- to say that something comes from given module which is not+            -- specified in the source code, e.g. @Prelude.map@.+            --+            -- My current understanding is that the provided module name+            -- serves no purpose for us and can be safely ignored.+            atom occName+          Exact name ->+            atom name+      m' = backticksWrapper (singleQuoteWrapper m)+  if doesNotNeedExtraParens x+    then m'+    else parensWrapper m'++-- | Whether given name should not have parentheses around it. This is used+-- to detect e.g. tuples for which annotations will indicate parentheses,+-- but the parentheses are already part of the symbol, so no extra layer of+-- parentheses should be added. It also detects the [] literal.+doesNotNeedExtraParens :: RdrName -> Bool+doesNotNeedExtraParens = \case+  Exact name ->+    let s = nameStableString name+     in -- I'm not sure this "stable string" is stable enough, but it looks+        -- like this is the most robust way to tell if we're looking at+        -- exactly this piece of built-in syntax.+        ("$ghc-prim$GHC.Tuple$" `isPrefixOf` s)+          || ("$ghc-prim$GHC.Types$[]" `isPrefixOf` s)+  _ -> False++p_qualName :: ModuleName -> OccName -> R ()+p_qualName mname occName = do+  atom mname+  txt "."+  atom occName++-- | A helper for formatting infix constructions in lhs of definitions.+p_infixDefHelper ::+  -- | Whether to format in infix style+  Bool ->+  -- | Indentation-bumping wrapper+  (R () -> R ()) ->+  -- | How to print the operator\/name+  R () ->+  -- | How to print the arguments+  [R ()] ->+  R ()+p_infixDefHelper isInfix inci' name args =+  case (isInfix, args) of+    (True, p0 : p1 : ps) -> do+      let parens' =+            if null ps+              then id+              else parens N+      parens' $ do+        p0+        breakpoint+        inci $ sitcc $ do+          name+          space+          p1+      unless (null ps) . inci' $ do+        breakpoint+        sitcc (sep breakpoint sitcc ps)+    (_, ps) -> do+      name+      unless (null ps) $ do+        breakpoint+        inci' $ sitcc (sep breakpoint sitcc args)++-- | Print a Haddock.+p_hsDocString ::+  -- | Haddock style+  HaddockStyle ->+  -- | Finish the doc string with a newline+  Bool ->+  -- | The doc string to render+  LHsDocString ->+  R ()+p_hsDocString hstyle needsNewline (L l str) = do+  let isCommentSpan = \case+        HaddockSpan _ _ -> True+        CommentSpan _ -> True+        _ -> False+  goesAfterComment <- maybe False isCommentSpan <$> getSpanMark+  -- Make sure the Haddock is separated by a newline from other comments.+  when goesAfterComment newline+  forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do+    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)+  when needsNewline newline+  case l of+    UnhelpfulSpan _ ->+      -- It's often the case that the comment itself doesn't have a span+      -- attached to it and instead its location can be obtained from+      -- 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
@@ -0,0 +1,315 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Rendering of declarations.+module Ormolu.Printer.Meat.Declaration+  ( p_hsDecls,+    p_hsDeclsRespectGrouping,+  )+where++import Data.List (sort)+import Data.List.NonEmpty ((<|), NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import GHC hiding (InlinePragma)+import OccName (occNameFS)+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Annotation+import Ormolu.Printer.Meat.Declaration.Class+import Ormolu.Printer.Meat.Declaration.Data+import Ormolu.Printer.Meat.Declaration.Default+import Ormolu.Printer.Meat.Declaration.Foreign+import Ormolu.Printer.Meat.Declaration.Instance+import Ormolu.Printer.Meat.Declaration.RoleAnnotation+import Ormolu.Printer.Meat.Declaration.Rule+import Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Declaration.Splice+import Ormolu.Printer.Meat.Declaration.Type+import Ormolu.Printer.Meat.Declaration.TypeFamily+import Ormolu.Printer.Meat.Declaration.Value+import Ormolu.Printer.Meat.Declaration.Warning+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++data UserGrouping+  = -- | Always put newlines where we think they should be+    Disregard+  | -- | Respect user preferences regarding grouping+    Respect+  deriving (Eq, Show)++p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDecls = p_hsDecls' Disregard++-- | Like 'p_hsDecls' but respects user choices regarding grouping. If the+-- user omits newlines between declarations, we also omit them in most+-- cases, except when said declarations have associated Haddocks.+--+-- Does some normalization (compress subsequent newlines into a single one)+p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDeclsRespectGrouping = p_hsDecls' Respect++p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDecls' grouping style decls = sepSemi id $+  -- Return a list of rendered declarations, adding a newline to separate+  -- groups.+  case groupDecls decls of+    [] -> []+    (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs)+  where+    renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style)+    renderGroupWithPrev prev curr =+      -- We can omit a blank line when the user didn't add one, but we must+      -- ensure we always add blank lines around documented declarations+      case grouping of+        Disregard ->+          breakpoint : renderGroup curr+        Respect ->+          if separatedByBlankNE getLoc prev curr+            || isDocumented prev+            || isDocumented curr+            then breakpoint : renderGroup curr+            else renderGroup curr++-- | Is a declaration group documented?+isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool+isDocumented = any (isHaddock . unLoc)+  where+    isHaddock DocNext = True+    isHaddock DocPrev = True+    isHaddock _ = False++-- | Group relevant declarations together.+--+-- Add a declaration to a group iff it is relevant to either the first or+-- the preceding declaration in the group.+groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)]+groupDecls [] = []+groupDecls (l@(L _ DocNext) : xs) =+  -- If the first element is a doc string for next element, just include it+  -- in the next block:+  case groupDecls xs of+    [] -> [l :| []]+    (x : xs') -> (l <| x) : xs'+groupDecls (header : xs) =+  let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) ->+        let relevantToHdr = groupedDecls header current+            relevantToPrev = groupedDecls previous current+         in relevantToHdr || relevantToPrev+   in (header :| map snd grp) : groupDecls (map snd rest)++p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()+p_hsDecl style = \case+  TyClD NoExtField x -> p_tyClDecl style x+  ValD NoExtField x -> p_valDecl x+  SigD NoExtField x -> p_sigDecl x+  InstD NoExtField x -> p_instDecl style x+  DerivD NoExtField x -> p_derivDecl x+  DefD NoExtField x -> p_defaultDecl x+  ForD NoExtField x -> p_foreignDecl x+  WarningD NoExtField x -> p_warnDecls x+  AnnD NoExtField x -> p_annDecl x+  RuleD NoExtField x -> p_ruleDecls x+  SpliceD NoExtField x -> p_spliceDecl x+  DocD NoExtField docDecl ->+    case docDecl of+      DocCommentNext str -> p_hsDocString Pipe False (noLoc str)+      DocCommentPrev str -> p_hsDocString Caret False (noLoc str)+      DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str)+      DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str)+  RoleAnnotD NoExtField x -> p_roleAnnot x+  KindSigD NoExtField s -> p_standaloneKindSig s+  XHsDecl x -> noExtCon x++p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()+p_tyClDecl style = \case+  FamDecl NoExtField x -> p_famDecl style x+  SynDecl {..} -> p_synDecl tcdLName tcdFixity tcdTyVars tcdRhs+  DataDecl {..} ->+    p_dataDecl+      Associated+      tcdLName+      (tyVarsToTypes tcdTyVars)+      tcdFixity+      tcdDataDefn+  ClassDecl {..} ->+    p_classDecl+      tcdCtxt+      tcdLName+      tcdTyVars+      tcdFixity+      tcdFDs+      tcdSigs+      tcdMeths+      tcdATs+      tcdATDefs+      tcdDocs+  XTyClDecl x -> noExtCon x++p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()+p_instDecl style = \case+  ClsInstD NoExtField x -> p_clsInstDecl x+  TyFamInstD NoExtField x -> p_tyFamInstDecl style x+  DataFamInstD NoExtField x -> p_dataFamInstDecl style x+  XInstDecl x -> noExtCon x++p_derivDecl :: DerivDecl GhcPs -> R ()+p_derivDecl = \case+  d@DerivDecl {} -> p_standaloneDerivDecl d+  XDerivDecl x -> noExtCon x++-- | Determine if these declarations should be grouped together.+groupedDecls ::+  LHsDecl GhcPs ->+  LHsDecl GhcPs ->+  Bool+groupedDecls (L l_x x') (L l_y y') =+  case (x', y') of+    (TypeSignature ns, FunctionBody ns') -> ns `intersects` ns'+    (TypeSignature ns, DefaultSignature ns') -> ns `intersects` ns'+    (DefaultSignature ns, TypeSignature ns') -> ns `intersects` ns'+    (DefaultSignature ns, FunctionBody ns') -> ns `intersects` ns'+    (x, FunctionBody ns) | Just ns' <- isPragma x -> ns `intersects` ns'+    (FunctionBody ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'+    (x, DataDeclaration n) | Just ns <- isPragma x -> n `elem` ns+    (DataDeclaration n, x)+      | Just ns <- isPragma x ->+        let f = occNameFS . rdrNameOcc in f n `elem` map f ns+    (x, y)+      | Just ns <- isPragma x,+        Just ns' <- isPragma y ->+        ns `intersects` ns'+    (x, TypeSignature ns) | Just ns' <- isPragma x -> ns `intersects` ns'+    (TypeSignature ns, x) | Just ns' <- isPragma x -> ns `intersects` ns'+    (PatternSignature ns, Pattern n) -> n `elem` ns+    (KindSignature n, DataDeclaration n') -> n == n'+    (KindSignature n, ClassDeclaration n') -> n == n'+    (KindSignature n, FamilyDeclaration n') -> n == n'+    -- Special case for TH splices, we look at locations+    (Splice, Splice) -> not (separatedByBlank id l_x l_y)+    -- This looks only at Haddocks, normal comments are handled elsewhere+    (DocNext, _) -> True+    (_, DocPrev) -> True+    _ -> False++intersects :: Ord a => [a] -> [a] -> Bool+intersects a b = go (sort a) (sort b)+  where+    go :: Ord a => [a] -> [a] -> Bool+    go _ [] = False+    go [] _ = False+    go (x : xs) (y : ys)+      | x < y = go xs (y : ys)+      | x > y = go (x : xs) ys+      | otherwise = True++isPragma ::+  HsDecl GhcPs ->+  Maybe [RdrName]+isPragma = \case+  InlinePragma n -> Just [n]+  SpecializePragma n -> Just [n]+  SCCPragma n -> Just [n]+  AnnTypePragma n -> Just [n]+  AnnValuePragma n -> Just [n]+  WarningPragma n -> Just n+  _ -> Nothing++-- Declarations that do not refer to names++pattern Splice :: HsDecl GhcPs+pattern Splice <- SpliceD NoExtField (SpliceDecl NoExtField _ _)++-- Declarations referring to a single name++pattern+  InlinePragma,+  SpecializePragma,+  SCCPragma,+  AnnTypePragma,+  AnnValuePragma,+  Pattern,+  DataDeclaration,+  ClassDeclaration,+  KindSignature,+  FamilyDeclaration ::+    RdrName -> HsDecl GhcPs+pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _)+pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _)+pattern SCCPragma n <- SigD NoExtField (SCCFunSig NoExtField _ (L _ n) _)+pattern AnnTypePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (TypeAnnProvenance (L _ n)) _)+pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _)+pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _))+pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _)+pattern ClassDeclaration n <- TyClD NoExtField (ClassDecl NoExtField _ (L _ n) _ _ _ _ _ _ _ _)+pattern KindSignature n <- KindSigD NoExtField (StandaloneKindSig NoExtField (L _ n) _)+pattern FamilyDeclaration n <- TyClD NoExtField (FamDecl NoExtField (FamilyDecl NoExtField _ (L _ n) _ _ _ _))++-- Declarations which can refer to multiple names++pattern+  TypeSignature,+  DefaultSignature,+  FunctionBody,+  PatternSignature,+  WarningPragma ::+    [RdrName] -> HsDecl GhcPs+pattern TypeSignature n <- (sigRdrNames -> Just n)+pattern DefaultSignature n <- (defSigRdrNames -> Just n)+pattern FunctionBody n <- (funRdrNames -> Just n)+pattern PatternSignature n <- (patSigRdrNames -> Just n)+pattern WarningPragma n <- (warnSigRdrNames -> Just n)++pattern DocNext, DocPrev :: HsDecl GhcPs+pattern DocNext <- (DocD NoExtField (DocCommentNext _))+pattern DocPrev <- (DocD NoExtField (DocCommentPrev _))++sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+sigRdrNames (SigD NoExtField (TypeSig NoExtField ns _)) = Just $ map unLoc ns+sigRdrNames (SigD NoExtField (ClassOpSig NoExtField _ ns _)) = Just $ map unLoc ns+sigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns+sigRdrNames _ = Nothing++defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+defSigRdrNames (SigD NoExtField (ClassOpSig NoExtField True ns _)) = Just $ map unLoc ns+defSigRdrNames _ = Nothing++funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _ _)) = Just [n]+funRdrNames (ValD NoExtField (PatBind NoExtField (L _ n) _ _)) = Just $ patBindNames n+funRdrNames _ = Nothing++patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns+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 _ = Nothing++patBindNames :: Pat GhcPs -> [RdrName]+patBindNames (TuplePat NoExtField ps _) = concatMap (patBindNames . unLoc) ps+patBindNames (VarPat NoExtField (L _ n)) = [n]+patBindNames (WildPat NoExtField) = []+patBindNames (LazyPat NoExtField (L _ p)) = patBindNames p+patBindNames (BangPat NoExtField (L _ p)) = patBindNames p+patBindNames (ParPat NoExtField (L _ p)) = patBindNames p+patBindNames (ListPat NoExtField ps) = concatMap (patBindNames . unLoc) ps+patBindNames (AsPat NoExtField (L _ n) (L _ p)) = n : patBindNames p+patBindNames (SumPat NoExtField (L _ p) _ _) = patBindNames p+patBindNames (ViewPat NoExtField _ (L _ p)) = patBindNames p+patBindNames (SplicePat NoExtField _) = []+patBindNames (LitPat NoExtField _) = []+patBindNames (SigPat _ (L _ p) _) = patBindNames p+patBindNames (NPat NoExtField _ _ _) = []+patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n]+patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)+patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer+patBindNames (CoPat NoExtField _ p _) = patBindNames p+patBindNames (XPat x) = noExtCon x
+ src/Ormolu/Printer/Meat/Declaration.hs-boot view
@@ -0,0 +1,13 @@+module Ormolu.Printer.Meat.Declaration+  ( p_hsDecls,+    p_hsDeclsRespectGrouping,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common++p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()++p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R ()
+ src/Ormolu/Printer/Meat/Declaration/Annotation.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Annotation+  ( p_annDecl,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Value++p_annDecl :: AnnDecl GhcPs -> R ()+p_annDecl = \case+  HsAnnotation NoExtField _ annProv expr -> pragma "ANN" . inci $ do+    p_annProv annProv+    breakpoint+    located expr p_hsExpr+  XAnnDecl x -> noExtCon x++p_annProv :: AnnProvenance (IdP GhcPs) -> R ()+p_annProv = \case+  ValueAnnProvenance name -> p_rdrName name+  TypeAnnProvenance name -> txt "type" >> space >> p_rdrName name+  ModuleAnnProvenance -> txt "module"
+ src/Ormolu/Printer/Meat/Declaration/Class.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of type class declarations.+module Ormolu.Printer.Meat.Declaration.Class+  ( p_classDecl,+  )+where++import Class+import Control.Arrow+import Control.Monad+import Data.Foldable+import Data.List (sortOn)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration+import Ormolu.Printer.Meat.Type++p_classDecl ::+  LHsContext GhcPs ->+  Located RdrName ->+  LHsQTyVars GhcPs ->+  LexicalFixity ->+  [Located (FunDep (Located RdrName))] ->+  [LSig GhcPs] ->+  LHsBinds GhcPs ->+  [LFamilyDecl GhcPs] ->+  [LTyFamDefltDecl GhcPs] ->+  [LDocDecl] ->+  R ()+p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = do+  let variableSpans = getLoc <$> hsq_explicit+      signatureSpans = getLoc name : variableSpans+      dependencySpans = getLoc <$> fdeps+      combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)+      -- GHC's AST does not necessarily store each kind of element in source+      -- location order. This happens because different declarations are stored+      -- in different lists. Consequently, to get all the declarations in proper+      -- order, they need to be manually sorted.+      sigs = (getLoc &&& fmap (SigD NoExtField)) <$> csigs+      vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cdefs+      tyFams = (getLoc &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats+      docs = (getLoc &&& fmap (DocD NoExtField)) <$> cdocs+      tyFamDefs =+        ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)+        )+          <$> catdefs+      allDecls =+        snd <$> sortOn fst (sigs <> vals <> tyFams <> tyFamDefs <> docs)+  txt "class"+  switchLayout combinedSpans $ do+    breakpoint+    inci $ do+      p_classContext ctx+      switchLayout signatureSpans $+        p_infixDefHelper+          (isInfix fixity)+          inci+          (p_rdrName name)+          (located' p_hsTyVarBndr <$> hsq_explicit)+      inci (p_classFundeps fdeps)+      unless (null allDecls) $ do+        breakpoint+        txt "where"+  unless (null allDecls) $ do+    breakpoint -- Ensure whitespace is added after where clause.+    inci (p_hsDeclsRespectGrouping Associated allDecls)+p_classDecl _ _ (XLHsQTyVars c) _ _ _ _ _ _ _ = noExtCon c++p_classContext :: LHsContext GhcPs -> R ()+p_classContext ctx = unless (null (unLoc ctx)) $ do+  located ctx p_hsContext+  space+  txt "=>"+  breakpoint++p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()+p_classFundeps fdeps = unless (null fdeps) $ do+  breakpoint+  txt "|"+  space+  sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps++p_funDep :: FunDep (Located RdrName) -> R ()+p_funDep (before, after) = do+  sep space p_rdrName before+  space+  txt "->"+  space+  sep space p_rdrName after++----------------------------------------------------------------------------+-- Helpers++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False
+ src/Ormolu/Printer/Meat/Declaration/Data.hs view
@@ -0,0 +1,268 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Renedring of data type declarations.+module Ormolu.Printer.Meat.Declaration.Data+  ( p_dataDecl,+  )+where++import Control.Monad+import Data.Maybe (isJust, maybeToList)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++p_dataDecl ::+  -- | Whether to format as data family+  FamilyStyle ->+  -- | Type constructor+  Located RdrName ->+  -- | Type patterns+  [LHsType GhcPs] ->+  -- | Lexical fixity+  LexicalFixity ->+  -- | Data definition+  HsDataDefn GhcPs ->+  R ()+p_dataDecl style name tpats fixity HsDataDefn {..} = do+  txt $ case dd_ND of+    NewType -> "newtype"+    DataType -> "data"+  txt $ case style of+    Associated -> mempty+    Free -> " instance"+  let constructorSpans = getLoc name : fmap getLoc tpats+  switchLayout constructorSpans $ do+    breakpoint+    inci $+      p_infixDefHelper+        (isInfix fixity)+        inci+        (p_rdrName name)+        (located' p_hsType <$> tpats)+  case dd_kindSig of+    Nothing -> return ()+    Just k -> do+      space+      txt "::"+      space+      located k p_hsType+  let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons+  unless (null dd_cons) $+    if gadt+      then inci $ do+        switchLayout constructorSpans $ do+          breakpoint+          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+  unless (null $ unLoc dd_derivs) breakpoint+  inci . located dd_derivs $ \xs ->+    sep newline (located' p_hsDerivingClause) xs+p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x++p_conDecl ::+  Bool ->+  ConDecl GhcPs ->+  R ()+p_conDecl singleConstRec = \case+  ConDeclGADT {..} -> do+    mapM_ (p_hsDocString Pipe True) con_doc+    let conDeclSpn =+          fmap getLoc con_names+            <> [getLoc con_forall]+            <> conTyVarsSpans con_qvars+            <> maybeToList (fmap getLoc con_mb_cxt)+            <> conArgsSpans con_args+    switchLayout conDeclSpn $ do+      case con_names of+        [] -> return ()+        (c : cs) -> do+          p_rdrName c+          unless (null cs) . inci $ do+            comma+            breakpoint+            sitcc $ sep (comma >> breakpoint) p_rdrName cs+      space+      inci $ do+        txt "::"+        let interArgBreak =+              if hasDocStrings (unLoc con_res_ty)+                then newline+                else breakpoint+        interArgBreak+        when (unLoc con_forall) $ do+          p_forallBndrs ForallInvis p_hsTyVarBndr (hsq_explicit con_qvars)+          interArgBreak+        forM_ con_mb_cxt p_lhsContext+        case con_args of+          PrefixCon xs -> do+            sep breakpoint (located' p_hsType) xs+            unless (null xs) $ do+              space+              txt "->"+              breakpoint+          RecCon l -> do+            located l p_conDeclFields+            unless (null $ unLoc l) $ do+              space+              txt "->"+              breakpoint+          InfixCon _ _ -> notImplemented "InfixCon"+        p_hsType (unLoc con_res_ty)+  ConDeclH98 {..} -> do+    mapM_ (p_hsDocString Pipe True) con_doc+    let conDeclWithContextSpn =+          [getLoc con_forall]+            <> fmap getLoc con_ex_tvs+            <> maybeToList (fmap getLoc con_mb_cxt)+            <> conDeclSpn+        conDeclSpn =+          getLoc con_name : conArgsSpans con_args+    switchLayout conDeclWithContextSpn $ do+      when (unLoc con_forall) $ do+        p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs+        breakpoint+      forM_ con_mb_cxt p_lhsContext+      switchLayout conDeclSpn $ case con_args of+        PrefixCon xs -> do+          p_rdrName con_name+          unless (null xs) breakpoint+          inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs+        RecCon l -> do+          p_rdrName con_name+          breakpoint+          let inci' =+                if singleConstRec+                  then id+                  else inci+          inci' (located l p_conDeclFields)+        InfixCon x y -> do+          located x p_hsType+          breakpoint+          inci $ do+            p_rdrName con_name+            space+            located y p_hsType+  XConDecl x -> noExtCon x++conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan]+conArgsSpans = \case+  PrefixCon xs ->+    getLoc <$> xs+  RecCon l ->+    [getLoc l]+  InfixCon x y ->+    [getLoc x, getLoc y]++conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan]+conTyVarsSpans = \case+  HsQTvs {..} -> getLoc <$> hsq_explicit+  XLHsQTyVars x -> noExtCon x++p_lhsContext ::+  LHsContext GhcPs ->+  R ()+p_lhsContext = \case+  L _ [] -> pure ()+  ctx -> do+    located ctx p_hsContext+    space+    txt "=>"+    breakpoint++isGadt :: ConDecl GhcPs -> Bool+isGadt = \case+  ConDeclGADT {} -> True+  ConDeclH98 {} -> False+  XConDecl {} -> False++p_hsDerivingClause ::+  HsDerivingClause GhcPs ->+  R ()+p_hsDerivingClause HsDerivingClause {..} = do+  txt "deriving"+  let derivingWhat = located deriv_clause_tys $ \case+        [] -> txt "()"+        xs ->+          parens N . sitcc $+            sep+              (comma >> breakpoint)+              (sitcc . located' p_hsType . hsib_body)+              xs+  space+  case deriv_clause_strategy of+    Nothing -> do+      breakpoint+      inci derivingWhat+    Just (L _ a) -> case a of+      StockStrategy -> do+        txt "stock"+        breakpoint+        inci derivingWhat+      AnyclassStrategy -> do+        txt "anyclass"+        breakpoint+        inci derivingWhat+      NewtypeStrategy -> do+        txt "newtype"+        breakpoint+        inci derivingWhat+      ViaStrategy HsIB {..} -> do+        breakpoint+        inci $ do+          derivingWhat+          breakpoint+          txt "via"+          space+          located hsib_body p_hsType+      ViaStrategy (XHsImplicitBndrs x) ->+        noExtCon x+p_hsDerivingClause (XHsDerivingClause x) = noExtCon x++----------------------------------------------------------------------------+-- Helpers++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False++isSingleConstRec :: [LConDecl GhcPs] -> Bool+isSingleConstRec [(L _ ConDeclH98 {..})] =+  case con_args of+    RecCon _ -> True+    _ -> False+isSingleConstRec _ = False++hasHaddocks :: [LConDecl GhcPs] -> Bool+hasHaddocks = any (f . unLoc)+  where+    f ConDeclH98 {..} = isJust con_doc+    f _ = False
+ src/Ormolu/Printer/Meat/Declaration/Default.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Default+  ( p_defaultDecl,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Type++p_defaultDecl :: DefaultDecl GhcPs -> R ()+p_defaultDecl = \case+  DefaultDecl NoExtField ts -> do+    txt "default"+    breakpoint+    inci . parens N . sitcc $+      sep (comma >> breakpoint) (sitcc . located' p_hsType) ts+  XDefaultDecl x -> noExtCon x
+ src/Ormolu/Printer/Meat/Declaration/Foreign.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Foreign+  ( p_foreignDecl,+  )+where++import BasicTypes+import Control.Monad+import Data.Text+import ForeignCall+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Signature++p_foreignDecl :: ForeignDecl GhcPs -> R ()+p_foreignDecl = \case+  fd@ForeignImport {fd_fi} -> do+    p_foreignImport fd_fi+    p_foreignTypeSig fd+  fd@ForeignExport {fd_fe} -> do+    p_foreignExport fd_fe+    p_foreignTypeSig fd+  XForeignDecl x -> noExtCon x++-- | Printer for the last part of an import\/export, which is function name+-- and type signature.+p_foreignTypeSig :: ForeignDecl GhcPs -> R ()+p_foreignTypeSig fd = do+  breakpoint+  inci+    . switchLayout+      [ getLoc (fd_name fd),+        (getLoc . hsib_body . fd_sig_ty) fd+      ]+    $ do+      p_rdrName (fd_name fd)+      p_typeAscription (HsWC NoExtField (fd_sig_ty fd))++-- | Printer for 'ForeignImport'.+--+-- These have the form:+--+-- > foreign import callingConvention [safety] [identifier]+--+-- We need to check whether the safety has a good source, span, as it+-- defaults to 'PlaySafe' if you don't have anything in the source.+--+-- We also layout the identifier using the 'SourceText', because printing+-- with the other two fields of 'CImport' is very complicated. See the+-- 'Outputable' instance of 'ForeignImport' for details.+p_foreignImport :: ForeignImport -> R ()+p_foreignImport (CImport cCallConv safety _ _ sourceText) = do+  txt "foreign import"+  space+  located cCallConv atom+  -- Need to check for 'noLoc' for the 'safe' annotation+  when (isGoodSrcSpan $ getLoc safety) (space >> atom safety)+  located sourceText p_sourceText++p_foreignExport :: ForeignExport -> R ()+p_foreignExport (CExport (L loc (CExportStatic _ _ cCallConv)) sourceText) = do+  txt "foreign export"+  space+  located (L loc cCallConv) atom+  located sourceText p_sourceText++p_sourceText :: SourceText -> R ()+p_sourceText = \case+  NoSourceText -> pure ()+  SourceText s -> space >> txt (pack s)
+ src/Ormolu/Printer/Meat/Declaration/Instance.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Type class, type family, and data family instance declarations.+module Ormolu.Printer.Meat.Declaration.Instance+  ( p_clsInstDecl,+    p_tyFamInstDecl,+    p_dataFamInstDecl,+    p_standaloneDerivDecl,+  )+where++import BasicTypes+import Control.Arrow+import Control.Monad+import Data.Foldable+import Data.List (sortOn)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration+import Ormolu.Printer.Meat.Declaration.Data+import Ormolu.Printer.Meat.Declaration.TypeFamily+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++p_standaloneDerivDecl :: DerivDecl GhcPs -> R ()+p_standaloneDerivDecl DerivDecl {..} = do+  let typesAfterInstance = located (hsib_body (hswc_body deriv_type)) p_hsType+      instTypes toIndent = inci $ do+        txt "instance"+        breakpoint+        match_overlap_mode deriv_overlap_mode breakpoint+        if toIndent+          then inci typesAfterInstance+          else typesAfterInstance+  txt "deriving"+  space+  case deriv_strategy of+    Nothing ->+      instTypes False+    Just (L _ a) -> case a of+      StockStrategy -> do+        txt "stock "+        instTypes False+      AnyclassStrategy -> do+        txt "anyclass "+        instTypes False+      NewtypeStrategy -> do+        txt "newtype "+        instTypes False+      ViaStrategy HsIB {..} -> do+        txt "via"+        breakpoint+        inci (located hsib_body p_hsType)+        breakpoint+        instTypes True+      ViaStrategy (XHsImplicitBndrs x) ->+        noExtCon x+p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl"++p_clsInstDecl :: ClsInstDecl GhcPs -> R ()+p_clsInstDecl = \case+  ClsInstDecl {..} -> do+    txt "instance"+    case cid_poly_ty of+      HsIB {..} -> do+        -- GHC's AST does not necessarily store each kind of element in source+        -- location order. This happens because different declarations are stored in+        -- different lists. Consequently, to get all the declarations in proper+        -- order, they need to be manually sorted.+        let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs+            vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds+            tyFamInsts =+              ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField)+              )+                <$> cid_tyfam_insts+            dataFamInsts =+              ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField)+              )+                <$> cid_datafam_insts+            allDecls =+              snd <$> sortOn fst (sigs <> vals <> tyFamInsts <> dataFamInsts)+        located hsib_body $ \x -> do+          breakpoint+          inci $ do+            match_overlap_mode cid_overlap_mode breakpoint+            p_hsType x+            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+      XHsImplicitBndrs x -> noExtCon x+  XClsInstDecl x -> noExtCon x++p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()+p_tyFamInstDecl style = \case+  TyFamInstDecl {..} -> do+    txt $ case style of+      Associated -> "type"+      Free -> "type instance"+    breakpoint+    inci (p_tyFamInstEqn tfid_eqn)++p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R ()+p_dataFamInstDecl style = \case+  DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}} ->+    p_dataDecl style feqn_tycon (map typeArgToType feqn_pats) feqn_fixity feqn_rhs+  DataFamInstDecl {dfid_eqn = HsIB {hsib_body = XFamEqn {}}} ->+    notImplemented "XFamEqn"+  DataFamInstDecl {dfid_eqn = XHsImplicitBndrs {}} ->+    notImplemented "XHsImplicitBndrs"++match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R ()+match_overlap_mode overlap_mode layoutStrategy =+  case unLoc <$> overlap_mode of+    Just Overlappable {} -> do+      txt "{-# OVERLAPPABLE #-}"+      layoutStrategy+    Just Overlapping {} -> do+      txt "{-# OVERLAPPING #-}"+      layoutStrategy+    Just Overlaps {} -> do+      txt "{-# OVERLAPS #-}"+      layoutStrategy+    Just Incoherent {} -> do+      txt "{-# INCOHERENT #-}"+      layoutStrategy+    _ -> pure ()
+ src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++-- | Rendering of Role annotation declarations.+module Ormolu.Printer.Meat.Declaration.RoleAnnotation+  ( p_roleAnnot,+  )+where++import CoAxiom+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common++p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()+p_roleAnnot = \case+  RoleAnnotDecl NoExtField l_name anns -> p_roleAnnot' l_name anns+  XRoleAnnotDecl x -> noExtCon x++p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R ()+p_roleAnnot' l_name anns = do+  txt "type role"+  breakpoint+  inci $ do+    p_rdrName l_name+    breakpoint+    let p_role' = maybe (txt "_") p_role+    inci . sitcc $ sep breakpoint (sitcc . located' p_role') anns++p_role :: Role -> R ()+p_role = \case+  Nominal -> txt "nominal"+  Representational -> txt "representational"+  Phantom -> txt "phantom"
+ src/Ormolu/Printer/Meat/Declaration/Rule.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Rule+  ( p_ruleDecls,+  )+where++import BasicTypes+import Control.Monad (unless)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Declaration.Value+import Ormolu.Printer.Meat.Type++p_ruleDecls :: RuleDecls GhcPs -> R ()+p_ruleDecls = \case+  HsRules NoExtField _ xs ->+    pragma "RULES" . sitcc $+      sep breakpoint (sitcc . located' p_ruleDecl) xs+  XRuleDecls x -> noExtCon x++p_ruleDecl :: RuleDecl GhcPs -> R ()+p_ruleDecl = \case+  HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs -> do+    located ruleName p_ruleName+    space+    p_activation activation+    space+    case tyvars of+      Nothing -> return ()+      Just xs -> do+        p_forallBndrs ForallInvis p_hsTyVarBndr xs+        space+    -- It appears that there is no way to tell if there was an empty forall+    -- in the input or no forall at all. We do not want to add redundant+    -- foralls, so let's just skip the empty ones.+    unless (null ruleBndrs) $+      p_forallBndrs ForallInvis p_ruleBndr ruleBndrs+    breakpoint+    inci $ do+      located lhs p_hsExpr+      space+      equals+      inci $ do+        breakpoint+        located rhs p_hsExpr+  XRuleDecl x -> noExtCon x++p_ruleName :: (SourceText, RuleName) -> R ()+p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs)++p_ruleBndr :: RuleBndr GhcPs -> R ()+p_ruleBndr = \case+  RuleBndr NoExtField x -> p_rdrName x+  RuleBndrSig NoExtField x hswc -> parens N $ do+    p_rdrName x+    p_typeAscription hswc+  XRuleBndr x -> noExtCon x
+ src/Ormolu/Printer/Meat/Declaration/Signature.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Type signature declarations.+module Ormolu.Printer.Meat.Declaration.Signature+  ( p_sigDecl,+    p_typeAscription,+    p_activation,+    p_standaloneKindSig,+  )+where++import BasicTypes+import BooleanFormula+import Control.Monad+import Data.Bool (bool)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++p_sigDecl :: Sig GhcPs -> R ()+p_sigDecl = \case+  TypeSig NoExtField names hswc -> p_typeSig True names hswc+  PatSynSig NoExtField names hsib -> p_patSynSig names hsib+  ClassOpSig NoExtField def names hsib -> p_classOpSig def names hsib+  FixSig NoExtField sig -> p_fixSig sig+  InlineSig NoExtField name inlinePragma -> p_inlineSig name inlinePragma+  SpecSig NoExtField name ts inlinePragma -> p_specSig name ts inlinePragma+  SpecInstSig NoExtField _ hsib -> p_specInstSig hsib+  MinimalSig NoExtField _ booleanFormula -> p_minimalSig booleanFormula+  CompleteMatchSig NoExtField _sourceText cs ty -> p_completeSig cs ty+  SCCFunSig NoExtField _ name literal -> p_sccSig name literal+  _ -> notImplemented "certain types of signature declarations"++p_typeSig ::+  -- | Should the tail of the names be indented+  Bool ->+  -- | Names (before @::@)+  [Located RdrName] ->+  -- | Type+  LHsSigWcType GhcPs ->+  R ()+p_typeSig _ [] _ = return () -- should not happen though+p_typeSig indentTail (n : ns) hswc = do+  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++p_typeAscription ::+  LHsSigWcType GhcPs ->+  R ()+p_typeAscription HsWC {..} = do+  space+  inci $ do+    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 ::+  [Located RdrName] ->+  HsImplicitBndrs GhcPs (LHsType GhcPs) ->+  R ()+p_patSynSig names hsib = do+  txt "pattern"+  let body =+        p_typeSig+          False+          names+          HsWC {hswc_ext = NoExtField, hswc_body = hsib}+  if length names > 1+    then breakpoint >> inci body+    else space >> body++p_classOpSig ::+  -- | Whether this is a \"default\" signature+  Bool ->+  -- | Names (before @::@)+  [Located RdrName] ->+  -- | Type+  HsImplicitBndrs GhcPs (LHsType GhcPs) ->+  R ()+p_classOpSig def names hsib = do+  when def (txt "default" >> space)+  p_typeSig True names HsWC {hswc_ext = NoExtField, hswc_body = hsib}++p_fixSig ::+  FixitySig GhcPs ->+  R ()+p_fixSig = \case+  FixitySig NoExtField names (Fixity _ n dir) -> do+    txt $ case dir of+      InfixL -> "infixl"+      InfixR -> "infixr"+      InfixN -> "infix"+    space+    atom n+    space+    sitcc $ sep (comma >> breakpoint) p_rdrName names+  XFixitySig x -> noExtCon x++p_inlineSig ::+  -- | Name+  Located RdrName ->+  -- | Inline pragma specification+  InlinePragma ->+  R ()+p_inlineSig name InlinePragma {..} = pragmaBraces $ do+  p_inlineSpec inl_inline+  space+  case inl_rule of+    ConLike -> txt "CONLIKE"+    FunLike -> return ()+  space+  p_activation inl_act+  space+  p_rdrName name++p_specSig ::+  -- | Name+  Located RdrName ->+  -- | The types to specialize to+  [LHsSigType GhcPs] ->+  -- | For specialize inline+  InlinePragma ->+  R ()+p_specSig name ts InlinePragma {..} = pragmaBraces $ do+  txt "SPECIALIZE"+  space+  p_inlineSpec inl_inline+  space+  p_activation inl_act+  space+  p_rdrName name+  space+  txt "::"+  breakpoint+  inci $ sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts++p_inlineSpec :: InlineSpec -> R ()+p_inlineSpec = \case+  Inline -> txt "INLINE"+  Inlinable -> txt "INLINEABLE"+  NoInline -> txt "NOINLINE"+  NoUserInline -> return ()++p_activation :: Activation -> R ()+p_activation = \case+  NeverActive -> return ()+  AlwaysActive -> return ()+  ActiveBefore _ n -> do+    txt "[~"+    atom n+    txt "]"+  ActiveAfter _ n -> do+    txt "["+    atom n+    txt "]"++p_specInstSig :: LHsSigType GhcPs -> R ()+p_specInstSig hsib =+  pragma "SPECIALIZE instance" . inci $+    located (hsib_body hsib) p_hsType++p_minimalSig ::+  -- | Boolean formula+  LBooleanFormula (Located RdrName) ->+  R ()+p_minimalSig =+  located' $ \booleanFormula ->+    pragma "MINIMAL" (inci $ p_booleanFormula booleanFormula)++p_booleanFormula ::+  -- | Boolean formula+  BooleanFormula (Located RdrName) ->+  R ()+p_booleanFormula = \case+  Var name -> p_rdrName name+  And xs ->+    sitcc $+      sep+        (comma >> breakpoint)+        (located' p_booleanFormula)+        xs+  Or xs ->+    sitcc $+      sep+        (breakpoint >> txt "| ")+        (located' p_booleanFormula)+        xs+  Parens l -> located l (parens N . p_booleanFormula)++p_completeSig ::+  -- | Constructors\/patterns+  Located [Located RdrName] ->+  -- | Type+  Maybe (Located RdrName) ->+  R ()+p_completeSig cs' mty =+  located cs' $ \cs ->+    pragma "COMPLETE" . inci $ do+      sitcc $ sep (comma >> breakpoint) p_rdrName cs+      forM_ mty $ \ty -> do+        space+        txt "::"+        breakpoint+        inci (p_rdrName ty)++p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R ()+p_sccSig loc literal = pragma "SCC" . inci $ do+  p_rdrName loc+  forM_ literal $ \x -> do+    breakpoint+    atom x++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+p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c
+ src/Ormolu/Printer/Meat/Declaration/Splice.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE LambdaCase #-}++module Ormolu.Printer.Meat.Declaration.Splice+  ( p_spliceDecl,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice)++p_spliceDecl :: SpliceDecl GhcPs -> R ()+p_spliceDecl = \case+  SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice+  XSpliceDecl x -> noExtCon x
+ src/Ormolu/Printer/Meat/Declaration/Type.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of type synonym declarations.+module Ormolu.Printer.Meat.Declaration.Type+  ( p_synDecl,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type++p_synDecl ::+  -- | Type constructor+  Located RdrName ->+  -- | Fixity+  LexicalFixity ->+  -- | Type variables+  LHsQTyVars GhcPs ->+  -- | RHS of type declaration+  LHsType GhcPs ->+  R ()+p_synDecl name fixity HsQTvs {..} t = do+  txt "type"+  space+  switchLayout (getLoc name : map getLoc hsq_explicit) $+    p_infixDefHelper+      (case fixity of Infix -> True; _ -> False)+      inci+      (p_rdrName name)+      (map (located' p_hsTyVarBndr) hsq_explicit)+  space+  equals+  if hasDocStrings (unLoc t)+    then newline+    else breakpoint+  inci (located t p_hsType)+p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x
+ src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs view
@@ -0,0 +1,116 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of data\/type families.+module Ormolu.Printer.Meat.Declaration.TypeFamily+  ( p_famDecl,+    p_tyFamInstEqn,+  )+where++import Control.Monad+import Data.Maybe (isNothing)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()+p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do+  mmeqs <- case fdInfo of+    DataFamily -> Nothing <$ txt "data"+    OpenTypeFamily -> Nothing <$ txt "type"+    ClosedTypeFamily eqs -> Just eqs <$ txt "type"+  txt $ case style of+    Associated -> mempty+    Free -> " family"+  breakpoint+  inci $ do+    switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $+      p_infixDefHelper+        (isInfix fdFixity)+        inci+        (p_rdrName fdLName)+        (located' p_hsTyVarBndr <$> hsq_explicit)+    let resultSig = p_familyResultSigL fdResultSig+    unless (isNothing resultSig && isNothing fdInjectivityAnn) space+    inci $ do+      sequence_ resultSig+      space+      forM_ fdInjectivityAnn (located' p_injectivityAnn)+  case mmeqs of+    Nothing -> return ()+    Just meqs -> do+      inci $ do+        breakpoint+        txt "where"+      case meqs of+        Nothing -> do+          space+          txt ".."+        Just eqs -> do+          newline+          sep newline (located' (inci . p_tyFamInstEqn)) eqs+p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} =+  notImplemented "XLHsQTyVars"+p_famDecl _ (XFamilyDecl x) = noExtCon x++p_familyResultSigL ::+  Located (FamilyResultSig GhcPs) ->+  Maybe (R ())+p_familyResultSigL l =+  case l of+    L _ a -> case a of+      NoSig NoExtField -> Nothing+      KindSig NoExtField k -> Just $ do+        txt "::"+        breakpoint+        located k p_hsType+      TyVarSig NoExtField bndr -> Just $ do+        equals+        breakpoint+        located bndr p_hsTyVarBndr+      XFamilyResultSig x ->+        noExtCon x++p_injectivityAnn :: InjectivityAnn GhcPs -> R ()+p_injectivityAnn (InjectivityAnn a bs) = do+  txt "|"+  space+  p_rdrName a+  space+  txt "->"+  space+  sep space p_rdrName bs++p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()+p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do+  case feqn_bndrs of+    Nothing -> return ()+    Just bndrs -> do+      p_forallBndrs ForallInvis p_hsTyVarBndr bndrs+      breakpoint+  (if null feqn_bndrs then id else inci) $ do+    let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats+    switchLayout famLhsSpn $+      p_infixDefHelper+        (isInfix feqn_fixity)+        inci+        (p_rdrName feqn_tycon)+        (located' p_hsType . typeArgToType <$> feqn_pats)+    space+    equals+    breakpoint+    inci (located feqn_rhs p_hsType)+p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x+p_tyFamInstEqn (XHsImplicitBndrs x) = noExtCon x++----------------------------------------------------------------------------+-- Helpers++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False
+ src/Ormolu/Printer/Meat/Declaration/Value.hs view
@@ -0,0 +1,1355 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeApplications #-}++module Ormolu.Printer.Meat.Declaration.Value+  ( p_valDecl,+    p_pat,+    p_hsExpr,+    p_hsSplice,+    p_stringLit,+  )+where++import Bag (bagToList)+import BasicTypes+import Control.Monad+import Ctype (is_space)+import Data.Bool (bool)+import Data.Char (isPunctuation, isSymbol)+import Data.Data hiding (Infix, Prefix)+import Data.Functor ((<&>))+import Data.List (intersperse, sortOn)+import Data.List.NonEmpty ((<|), NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import Data.Text (Text)+import qualified Data.Text as Text+import GHC+import OccName (mkVarOcc)+import Ormolu.Printer.Combinators+import Ormolu.Printer.Internal+import Ormolu.Printer.Meat.Common+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration+import Ormolu.Printer.Meat.Declaration.Signature+import Ormolu.Printer.Meat.Type+import Ormolu.Printer.Operators+import Ormolu.Utils++-- | Style of a group of equations.+data MatchGroupStyle+  = Function (Located RdrName)+  | PatternBind+  | Case+  | Lambda+  | LambdaCase++-- | Style of equations in a group.+data GroupStyle+  = EqualSign+  | RightArrow++-- | Expression placement. This marks the places where expressions that+-- implement handing forms may use them.+data Placement+  = -- | Multi-line layout should cause+    -- insertion of a newline and indentation+    -- bump+    Normal+  | -- | Expressions that have hanging form+    -- should use it and avoid bumping one level+    -- of indentation+    Hanging+  deriving (Eq)++p_valDecl :: HsBindLR GhcPs GhcPs -> R ()+p_valDecl = \case+  FunBind NoExtField funId funMatches _ _ -> p_funBind funId funMatches+  PatBind NoExtField pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss+  VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker+  AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker+  PatSynBind NoExtField psb -> p_patSynBind psb+  XHsBindsLR x -> noExtCon x++p_funBind ::+  Located RdrName ->+  MatchGroup GhcPs (LHsExpr GhcPs) ->+  R ()+p_funBind name = p_matchGroup (Function name)++p_matchGroup ::+  MatchGroupStyle ->+  MatchGroup GhcPs (LHsExpr GhcPs) ->+  R ()+p_matchGroup = p_matchGroup' exprPlacement p_hsExpr++p_matchGroup' ::+  Data body =>+  -- | How to get body placement+  (body -> Placement) ->+  -- | How to print body+  (body -> R ()) ->+  -- | Style of this group of equations+  MatchGroupStyle ->+  -- | Match group+  MatchGroup GhcPs (Located body) ->+  R ()+p_matchGroup' placer render style MG {..} = do+  let ob = case style of+        Case -> id+        LambdaCase -> id+        _ -> dontUseBraces+  -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to+  -- restore the brace state inside the sepsemi.+  ub <- bool dontUseBraces useBraces <$> canUseBraces+  ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts)+  where+    p_Match m@Match {..} =+      p_match'+        placer+        render+        (adjustMatchGroupStyle m style)+        (isInfixMatch m)+        (matchStrictness m)+        m_pats+        m_grhss+    p_Match (XMatch x) = noExtCon x+p_matchGroup' _ _ _ (XMatchGroup x) = noExtCon x++-- | Function id obtained through pattern matching on 'FunBind' should not+-- be used to print the actual equations because the different ‘RdrNames’+-- used in the equations may have different “decorations” (such as backticks+-- and paretheses) associated with them. It is necessary to use per-equation+-- names obtained from 'm_ctxt' of 'Match'. This function replaces function+-- name inside of 'Function' accordingly.+adjustMatchGroupStyle ::+  Match GhcPs body ->+  MatchGroupStyle ->+  MatchGroupStyle+adjustMatchGroupStyle m = \case+  Function _ -> (Function . mc_fun . m_ctxt) m+  style -> style++matchStrictness :: Match id body -> SrcStrictness+matchStrictness match =+  case m_ctxt match of+    FunRhs {mc_strictness = s} -> s+    _ -> NoSrcStrict++p_match ::+  -- | Style of the group+  MatchGroupStyle ->+  -- | Is this an infix match?+  Bool ->+  -- | Strictness prefix (FunBind)+  SrcStrictness ->+  -- | Argument patterns+  [LPat GhcPs] ->+  -- | Equations+  GRHSs GhcPs (LHsExpr GhcPs) ->+  R ()+p_match = p_match' exprPlacement p_hsExpr++p_match' ::+  Data body =>+  -- | How to get body placement+  (body -> Placement) ->+  -- | How to print body+  (body -> R ()) ->+  -- | Style of this group of equations+  MatchGroupStyle ->+  -- | Is this an infix match?+  Bool ->+  -- | Strictness prefix (FunBind)+  SrcStrictness ->+  -- | Argument patterns+  [LPat GhcPs] ->+  -- | Equations+  GRHSs GhcPs (Located body) ->+  R ()+p_match' placer render style isInfix strictness m_pats GRHSs {..} = do+  -- Normally, since patterns may be placed in a multi-line layout, it is+  -- necessary to bump indentation for the pattern group so it's more+  -- indented than function name. This in turn means that indentation for+  -- the body should also be bumped. Normally this would mean that bodies+  -- would start with two indentation steps applied, which is ugly, so we+  -- need to be a bit more clever here and bump indentation level only when+  -- pattern group is multiline.+  case strictness of+    NoSrcStrict -> return ()+    SrcStrict -> txt "!"+    SrcLazy -> txt "~"+  inci' <- case NE.nonEmpty m_pats of+    Nothing -> id <$ 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+      switchLayout [combinedSpans] $ do+        let stdCase = sep breakpoint (located' p_pat) m_pats+        case style of+          Function name ->+            p_infixDefHelper+              isInfix+              inci'+              (p_rdrName name)+              (located' p_pat <$> m_pats)+          PatternBind -> stdCase+          Case -> stdCase+          Lambda -> do+            let needsSpace = case unLoc (NE.head ne_pats) of+                  LazyPat _ _ -> True+                  BangPat _ _ -> True+                  SplicePat _ _ -> True+                  _ -> False+            txt "\\"+            when needsSpace space+            sitcc stdCase+          LambdaCase -> stdCase+      return inci'+  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+        Nothing -> case style of+          Function name -> Just (getLoc name)+          _ -> Nothing+        Just pats -> (Just . getLoc . NE.last) pats+      isCase = \case+        Case -> True+        LambdaCase -> True+        _ -> False+  let hasGuards = withGuards grhssGRHSs+      grhssSpan =+        combineSrcSpans' $+          getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs+      patGrhssSpan =+        maybe+          grhssSpan+          (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd)+          endOfPats+      placement =+        case endOfPats of+          Nothing -> blockPlacement placer grhssGRHSs+          Just spn ->+            if onTheSameLine spn grhssSpan+              then blockPlacement placer grhssGRHSs+              else Normal+      p_body = do+        let groupStyle =+              if isCase style && hasGuards+                then RightArrow+                else EqualSign+        sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs+      p_where = do+        let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)+        unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do+          breakpoint+          txt "where"+          unless whereIsEmpty breakpoint+          inci $ located grhssLocalBinds p_hsLocalBinds+  inci' $ do+    unless (length grhssGRHSs > 1) $+      case style of+        Function _ | hasGuards -> return ()+        Function _ -> space >> inci equals+        PatternBind -> space >> inci equals+        s | isCase s && hasGuards -> return ()+        _ -> space >> txt "->"+    switchLayout [patGrhssSpan] $+      placeHanging placement p_body+    inci p_where+p_match' _ _ _ _ _ _ (XGRHSs x) = noExtCon x++p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()+p_grhs = p_grhs' exprPlacement p_hsExpr++p_grhs' ::+  Data body =>+  -- | How to get body placement+  (body -> Placement) ->+  -- | How to print body+  (body -> R ()) ->+  GroupStyle ->+  GRHS GhcPs (Located body) ->+  R ()+p_grhs' placer render style (GRHS NoExtField guards body) =+  case guards of+    [] -> p_body+    xs -> do+      txt "|"+      space+      sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)+      space+      inci $ case style of+        EqualSign -> equals+        RightArrow -> txt "->"+      placeHanging placement p_body+  where+    placement =+      case endOfGuards of+        Nothing -> placer (unLoc body)+        Just spn ->+          if onTheSameLine spn (getLoc body)+            then placer (unLoc body)+            else Normal+    endOfGuards =+      case NE.nonEmpty guards of+        Nothing -> Nothing+        Just gs -> (Just . getLoc . NE.last) gs+    p_body = located body render+p_grhs' _ _ _ (XGRHS x) = noExtCon x++p_hsCmd :: HsCmd GhcPs -> R ()+p_hsCmd = \case+  HsCmdArrApp NoExtField body input arrType _ -> do+    located body p_hsExpr+    breakpoint+    inci $ do+      case arrType of+        HsFirstOrderApp -> txt "-<"+        HsHigherOrderApp -> txt "-<<"+      placeHanging (exprPlacement (unLoc input)) $+        located input p_hsExpr+  HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ sitcc $ do+    located form p_hsExpr+    unless (null cmds) $ do+      breakpoint+      inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))+  HsCmdArrForm NoExtField form Infix _ [left, right] -> do+    located left p_hsCmdTop+    space+    located form p_hsExpr+    placeHanging (cmdTopPlacement (unLoc right)) $+      located right p_hsCmdTop+  HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm"+  HsCmdApp {} ->+    -- XXX Does this ever occur in the syntax tree? It does not seem like it+    -- 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)+  HsCmdCase NoExtField e mgroup ->+    p_case cmdPlacement p_hsCmd e mgroup+  HsCmdIf NoExtField _ if' then' else' ->+    p_if cmdPlacement p_hsCmd if' then' else'+  HsCmdLet NoExtField localBinds c ->+    p_let p_hsCmd localBinds c+  HsCmdDo NoExtField es -> do+    txt "do"+    newline+    inci . located es $+      sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement p_hsCmd))+  HsCmdWrap {} -> notImplemented "HsCmdWrap"+  XCmd x -> noExtCon x++p_hsCmdTop :: HsCmdTop GhcPs -> R ()+p_hsCmdTop = \case+  HsCmdTop NoExtField cmd -> located cmd p_hsCmd+  XCmdTop x -> noExtCon x++withSpacing :: Data a => (a -> R ()) -> Located a -> R ()+withSpacing f l = located l $ \x -> do+  case getLoc l of+    UnhelpfulSpan _ -> f x+    RealSrcSpan currentSpn -> do+      getSpanMark >>= \case+        -- Spacing before comments will be handled by the code+        -- that prints comments, so we just have to deal with+        -- blank lines between statements here.+        Just (StatementSpan lastSpn) ->+          if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1+            then newline+            else return ()+        _ -> return ()+      f x+      -- In some cases the (f x) expression may insert a new mark. We want+      -- to be careful not to override comment marks.+      getSpanMark >>= \case+        Just (HaddockSpan _ _) -> return ()+        Just (CommentSpan _) -> return ()+        _ -> setSpanMark (StatementSpan currentSpn)++p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R ()+p_stmt = p_stmt' exprPlacement p_hsExpr++p_stmt' ::+  Data body =>+  -- | Placer+  (body -> Placement) ->+  -- | Render+  (body -> R ()) ->+  -- | Statement to render+  Stmt GhcPs (Located body) ->+  R ()+p_stmt' placer render = \case+  LastStmt NoExtField body _ _ -> located body render+  BindStmt NoExtField p f _ _ -> do+    located p p_pat+    space+    txt "<-"+    let loc = getLoc p+        placement =+          case f of+            L l' x ->+              if isOneLineSpan+                (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l'))+                then placer x+                else Normal+    switchLayout [loc, getLoc f] $+      placeHanging placement (located f render)+  ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer+  BodyStmt NoExtField body _ _ -> located body render+  LetStmt NoExtField binds -> do+    txt "let"+    space+    sitcc $ located binds p_hsLocalBinds+  ParStmt {} ->+    -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such+    -- that it never occurs in 'p_stmt''. Consequently, handling it here+    -- would be redundant.+    notImplemented "ParStmt"+  TransStmt {..} ->+    -- 'TransStmt' only needs to account for render printing itself, since+    -- pretty printing of relevant statements (e.g., in 'trS_stmts') is+    -- handled through 'gatherStmt'.+    case (trS_form, trS_by) of+      (ThenForm, Nothing) -> do+        txt "then"+        breakpoint+        inci $ located trS_using p_hsExpr+      (ThenForm, Just e) -> do+        txt "then"+        breakpoint+        inci $ located trS_using p_hsExpr+        breakpoint+        txt "by"+        breakpoint+        inci $ located e p_hsExpr+      (GroupForm, Nothing) -> do+        txt "then group using"+        breakpoint+        inci $ located trS_using p_hsExpr+      (GroupForm, Just e) -> do+        txt "then group by"+        breakpoint+        inci $ located e p_hsExpr+        breakpoint+        txt "using"+        breakpoint+        inci $ located trS_using p_hsExpr+  RecStmt {..} -> do+    txt "rec"+    space+    sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts+  XStmtLR c -> noExtCon c++gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]+gatherStmt (L _ (ParStmt NoExtField block _ _)) =+  foldr ((<>) . gatherStmtBlock) [] block+gatherStmt (L s stmt@TransStmt {..}) =+  foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]])+gatherStmt stmt = [[stmt]]++gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]]+gatherStmtBlock (ParStmtBlock _ stmts _ _) =+  foldr (liftAppend . gatherStmt) [] stmts+gatherStmtBlock (XParStmtBlock x) = noExtCon x++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)+  HsValBinds NoExtField _ -> notImplemented "HsValBinds"+  HsIPBinds NoExtField (IPBinds NoExtField xs) ->+    -- Second argument of IPBind is always Left before type-checking.+    let p_ipBind (IPBind NoExtField (Left name) expr) = do+          atom name+          space+          equals+          breakpoint+          useBraces $ inci $ located expr p_hsExpr+        p_ipBind (IPBind NoExtField (Right _) _) =+          -- Should only occur after the type checker+          notImplemented "IPBind _ (Right _) _"+        p_ipBind (XIPBind x) = noExtCon x+     in sepSemi (located' p_ipBind) xs+  HsIPBinds NoExtField _ -> notImplemented "HsIpBinds"+  EmptyLocalBinds NoExtField -> return ()+  XHsLocalBindsLR x -> noExtCon x++p_hsRecField ::+  HsRecField' RdrName (LHsExpr GhcPs) ->+  R ()+p_hsRecField HsRecField {..} = do+  p_rdrName hsRecFieldLbl+  unless hsRecPun $ do+    space+    equals+    let placement =+          if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg)+            then exprPlacement (unLoc hsRecFieldArg)+            else Normal+    placeHanging placement (located hsRecFieldArg p_hsExpr)++p_hsTupArg :: HsTupArg GhcPs -> R ()+p_hsTupArg = \case+  Present NoExtField x -> located x p_hsExpr+  Missing NoExtField -> pure ()+  XTupArg x -> noExtCon x++p_hsExpr :: HsExpr GhcPs -> R ()+p_hsExpr = p_hsExpr' N++p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()+p_hsExpr' s = \case+  HsVar NoExtField name -> p_rdrName name+  HsUnboundVar NoExtField v -> atom (unboundVarOcc v)+  HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut"+  HsRecFld NoExtField x ->+    case x of+      Unambiguous NoExtField name -> p_rdrName name+      Ambiguous NoExtField name -> p_rdrName name+      XAmbiguousFieldOcc xx -> noExtCon xx+  HsOverLabel NoExtField _ v -> do+    txt "#"+    atom v+  HsIPVar NoExtField (HsIPName name) -> do+    txt "?"+    atom name+  HsOverLit NoExtField v -> atom (ol_val v)+  HsLit NoExtField lit ->+    case lit of+      HsString (SourceText stxt) _ -> p_stringLit stxt+      HsStringPrim (SourceText stxt) _ -> p_stringLit stxt+      r -> atom r+  HsLam NoExtField mgroup ->+    p_matchGroup Lambda mgroup+  HsLamCase NoExtField mgroup -> do+    txt "\\case"+    breakpoint+    inci (p_matchGroup LambdaCase mgroup)+  HsApp NoExtField f x -> do+    let -- In order to format function applications with multiple parameters+        -- nicer, traverse the AST to gather the function and all the+        -- parameters together.+        gatherArgs f' knownArgs =+          case f' of+            L _ (HsApp _ l r) -> gatherArgs l (r <| knownArgs)+            _ -> (f', knownArgs)+        (func, args) = gatherArgs f (x :| [])+        -- We need to handle the last argument specially if it is a+        -- hanging construct, so separate it from the rest.+        (initp, lastp) = (NE.init args, NE.last args)+        initSpan =+          combineSrcSpans' $+            getLoc f :| [(srcLocSpan . srcSpanStart . getLoc) lastp]+        -- Hang the last argument only if the initial arguments span one+        -- line.+        placement =+          if isOneLineSpan initSpan+            then exprPlacement (unLoc lastp)+            else Normal+    -- If the last argument is not hanging, just separate every argument as+    -- usual. If it is hanging, print the initial arguments and hang the+    -- last one. Also, use braces around the every argument except the last+    -- one.+    case placement of+      Normal -> do+        let -- Usually we want to bump indentation for arguments for the+            -- sake of readability. However, when the function itself is a+            -- 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 =+              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+        ub $ do+          located func (p_hsExpr' s)+          breakpoint+          indent $ sep breakpoint (located' p_hsExpr) initp+        indent $ do+          unless (null initp) breakpoint+          located lastp p_hsExpr+      Hanging -> do+        useBraces . switchLayout [initSpan] $ do+          located func (p_hsExpr' s)+          breakpoint+          sep breakpoint (located' p_hsExpr) initp+        placeHanging placement $+          located lastp p_hsExpr+  HsAppType NoExtField e a -> do+    located e p_hsExpr+    breakpoint+    inci $ do+      txt "@"+      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)+  NegApp NoExtField e _ -> do+    txt "-"+    space+    located e p_hsExpr+  HsPar NoExtField e ->+    parens s (located e (dontUseBraces . p_hsExpr))+  SectionL NoExtField x op -> do+    located x p_hsExpr+    breakpoint+    inci (located op p_hsExpr)+  SectionR NoExtField op x -> do+    located op p_hsExpr+    useRecordDot' <- useRecordDot+    let isRecordDot' = isRecordDot (unLoc op) (getLoc x)+    unless (useRecordDot' && isRecordDot') breakpoint+    inci (located x p_hsExpr)+  ExplicitTuple NoExtField args boxity -> do+    let isSection = any (isMissing . unLoc) args+        isMissing = \case+          Missing NoExtField -> True+          _ -> False+    let 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+  ExplicitSum NoExtField tag arity e ->+    p_unboxedSum N tag arity (located e p_hsExpr)+  HsCase NoExtField e mgroup ->+    p_case exprPlacement p_hsExpr e mgroup+  HsIf NoExtField _ if' then' else' ->+    p_if exprPlacement p_hsExpr if' then' else'+  HsMultiIf NoExtField guards -> do+    txt "if"+    breakpoint+    inci . inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards+  HsLet NoExtField localBinds e ->+    p_let p_hsExpr localBinds e+  HsDo NoExtField ctx es -> do+    let doBody header = do+          txt header+          breakpoint+          ub <- layoutToBraces <$> getLayout+          inci $+            sepSemi+              (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S)))+              (unLoc es)+        compBody = brackets N $ located es $ \xs -> do+          let p_parBody =+                sep+                  (breakpoint >> txt "| ")+                  p_seqBody+              p_seqBody =+                sitcc+                  . sep+                    (comma >> breakpoint)+                    (located' (sitcc . p_stmt))+              stmts = init xs+              yield = last xs+              lists = foldr (liftAppend . gatherStmt) [] stmts+          located yield p_stmt+          breakpoint+          txt "|"+          space+          p_parBody lists+    case ctx of+      DoExpr -> doBody "do"+      MDoExpr -> doBody "mdo"+      ListComp -> compBody+      MonadComp -> notImplemented "MonadComp"+      ArrowExpr -> notImplemented "ArrowExpr"+      GhciStmtCtxt -> notImplemented "GhciStmtCtxt"+      PatGuard _ -> notImplemented "PatGuard"+      ParStmtCtxt _ -> notImplemented "ParStmtCtxt"+      TransStmtCtxt _ -> notImplemented "TransStmtCtxt"+  ExplicitList _ _ xs ->+    brackets s . sitcc $+      sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs+  RecordCon {..} -> do+    located rcon_con_name atom+    breakpoint+    let HsRecFields {..} = rcon_flds+        updName f =+          (f :: HsRecField GhcPs (LHsExpr GhcPs))+            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of+                FieldOcc _ n -> n+                XFieldOcc x -> noExtCon x+            }+        fields = located' (p_hsRecField . updName) <$> rec_flds+        dotdot =+          case rec_dotdot of+            Just {} -> [txt ".."]+            Nothing -> []+    inci . braces N . sitcc $+      sep (comma >> breakpoint) sitcc (fields <> dotdot)+  RecordUpd {..} -> do+    located rupd_expr p_hsExpr+    useRecordDot' <- useRecordDot+    let mrs sp = case getLoc sp of+          RealSrcSpan r -> Just r+          _ -> Nothing+    let isPluginForm =+          ((1 +) . srcSpanEndCol <$> mrs rupd_expr)+            == (srcSpanStartCol <$> mrs (head rupd_flds))+    unless (useRecordDot' && isPluginForm) breakpoint+    let updName f =+          (f :: HsRecUpdField GhcPs)+            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of+                Ambiguous _ n -> n+                Unambiguous _ n -> n+                XAmbiguousFieldOcc x -> noExtCon x+            }+    inci . braces N . sitcc $+      sep+        (comma >> breakpoint)+        (sitcc . located' (p_hsRecField . updName))+        rupd_flds+  ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do+    located x p_hsExpr+    space+    txt "::"+    breakpoint+    inci $ located hsib_body p_hsType+  ExprWithTySig NoExtField _ HsWC {hswc_body = XHsImplicitBndrs x} -> noExtCon x+  ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x+  ArithSeq NoExtField _ x ->+    case x of+      From from -> brackets s . sitcc $ do+        located from p_hsExpr+        breakpoint+        txt ".."+      FromThen from next -> brackets s . sitcc $ do+        sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]+        breakpoint+        txt ".."+      FromTo from to -> brackets s . sitcc $ 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]+        breakpoint+        txt ".."+        space+        located to p_hsExpr+  HsSCC NoExtField _ name x -> do+    txt "{-# SCC "+    atom name+    txt " #-}"+    breakpoint+    located x p_hsExpr+  HsCoreAnn NoExtField _ value x -> do+    txt "{-# CORE "+    atom value+    txt " #-}"+    breakpoint+    located x p_hsExpr+  HsBracket NoExtField x -> p_hsBracket x+  HsRnBracketOut {} -> notImplemented "HsRnBracketOut"+  HsTcBracketOut {} -> notImplemented "HsTcBracketOut"+  HsSpliceE NoExtField splice -> p_hsSplice splice+  HsProc NoExtField p e -> do+    txt "proc"+    located p $ \x -> do+      breakpoint+      inci (p_pat x)+      breakpoint+    txt "->"+    placeHanging (cmdTopPlacement (unLoc e)) $+      located e p_hsCmdTop+  HsStatic _ e -> do+    txt "static"+    breakpoint+    inci (located e p_hsExpr)+  HsTick {} -> notImplemented "HsTick"+  HsBinTick {} -> notImplemented "HsBinTick"+  HsTickPragma {} -> notImplemented "HsTickPragma"+  HsWrap {} -> notImplemented "HsWrap"+  XExpr x -> noExtCon x++p_patSynBind :: PatSynBind GhcPs GhcPs -> R ()+p_patSynBind PSB {..} = do+  let rhs = do+        space+        case psb_dir of+          Unidirectional -> do+            txt "<-"+            breakpoint+            located psb_def p_pat+          ImplicitBidirectional -> do+            equals+            breakpoint+            located psb_def p_pat+          ExplicitBidirectional mgroup -> do+            txt "<-"+            breakpoint+            located psb_def p_pat+            newline+            txt "where"+            newline+            inci (p_matchGroup (Function psb_id) mgroup)+  txt "pattern"+  case psb_args of+    PrefixCon xs -> do+      space+      p_rdrName psb_id+      inci $ do+        switchLayout (getLoc <$> xs) $ do+          unless (null xs) breakpoint+          sitcc (sep breakpoint p_rdrName xs)+        rhs+    RecCon xs -> do+      space+      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+        rhs+    InfixCon l r -> do+      switchLayout [getLoc l, getLoc r] $ do+        space+        p_rdrName l+        breakpoint+        inci $ do+          p_rdrName psb_id+          space+          p_rdrName r+      inci rhs+p_patSynBind (XPatSynBind x) = noExtCon x++p_case ::+  Data body =>+  -- | Placer+  (body -> Placement) ->+  -- | Render+  (body -> R ()) ->+  -- | Expression+  LHsExpr GhcPs ->+  -- | Match group+  MatchGroup GhcPs (Located body) ->+  R ()+p_case placer render e mgroup = do+  txt "case"+  space+  located e p_hsExpr+  space+  txt "of"+  breakpoint+  inci (p_matchGroup' placer render Case mgroup)++p_if ::+  Data body =>+  -- | Placer+  (body -> Placement) ->+  -- | Render+  (body -> R ()) ->+  -- | If+  LHsExpr GhcPs ->+  -- | Then+  Located body ->+  -- | Else+  Located body ->+  R ()+p_if placer render if' then' else' = do+  txt "if"+  space+  located if' p_hsExpr+  breakpoint+  inci $ do+    txt "then"+    space+    located then' $ \x ->+      placeHanging (placer x) (render x)+    breakpoint+    txt "else"+    space+    located else' $ \x ->+      placeHanging (placer x) (render x)++p_let ::+  Data body =>+  -- | Render+  (body -> R ()) ->+  Located (HsLocalBindsLR GhcPs GhcPs) ->+  Located body ->+  R ()+p_let render localBinds e = sitcc $ do+  txt "let"+  space+  dontUseBraces $ sitcc (located localBinds p_hsLocalBinds)+  vlayout space (newline >> txt " ")+  txt "in"+  space+  sitcc (located e render)++p_pat :: Pat GhcPs -> R ()+p_pat = \case+  WildPat NoExtField -> txt "_"+  VarPat NoExtField name -> p_rdrName name+  LazyPat NoExtField pat -> do+    txt "~"+    located pat p_pat+  AsPat NoExtField name pat -> do+    p_rdrName name+    txt "@"+    located pat p_pat+  ParPat NoExtField pat ->+    located pat (parens S . p_pat)+  BangPat NoExtField pat -> do+    txt "!"+    located pat p_pat+  ListPat NoExtField pats ->+    brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats+  TuplePat NoExtField pats boxing -> do+    let f =+          case boxing of+            Boxed -> parens S+            Unboxed -> parensHash S+    f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats+  SumPat NoExtField pat tag arity ->+    p_unboxedSum S tag arity (located pat p_pat)+  ConPatIn pat details ->+    case details of+      PrefixCon xs -> sitcc $ do+        p_rdrName pat+        unless (null xs) $ do+          breakpoint+          inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs+      RecCon (HsRecFields fields dotdot) -> do+        p_rdrName pat+        breakpoint+        let f = \case+              Nothing -> txt ".."+              Just x -> located x p_pat_hsRecField+        inci . braces N . sitcc . sep (comma >> breakpoint) f $+          case dotdot of+            Nothing -> Just <$> fields+            Just (L _ n) -> (Just <$> take n fields) ++ [Nothing]+      InfixCon l r -> do+        switchLayout [getLoc l, getLoc r] $ do+          located l p_pat+          breakpoint+          inci $ do+            p_rdrName pat+            space+            located r p_pat+  ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?+  ViewPat NoExtField expr pat -> sitcc $ do+    located expr p_hsExpr+    space+    txt "->"+    breakpoint+    inci (located pat p_pat)+  SplicePat NoExtField splice -> p_hsSplice splice+  LitPat NoExtField p -> atom p+  NPat NoExtField v _ _ -> located v (atom . ol_val)+  NPlusKPat NoExtField n k _ _ _ -> sitcc $ do+    p_rdrName n+    breakpoint+    inci $ do+      txt "+"+      space+      located k (atom . ol_val)+  SigPat NoExtField pat hswc -> do+    located pat p_pat+    p_typeAscription hswc+  CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage+  XPat x -> noExtCon x++p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R ()+p_pat_hsRecField HsRecField {..} = do+  located hsRecFieldLbl $ \x ->+    p_rdrName (rdrNameFieldOcc x)+  unless hsRecPun $ do+    space+    equals+    breakpoint+    inci (located hsRecFieldArg p_pat)++p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()+p_unboxedSum s tag arity m = do+  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+        case x :: Maybe (R ()) of+          Nothing ->+            unless (isFirst || isLast) space+          Just m' -> do+            unless isFirst space+            m'+            unless isLast space+  parensHash s $ sep (txt "|") f (zip args [0 ..])++p_hsSplice :: HsSplice GhcPs -> R ()+p_hsSplice = \case+  HsTypedSplice NoExtField deco _ expr -> p_hsSpliceTH True expr deco+  HsUntypedSplice NoExtField deco _ expr -> p_hsSpliceTH False expr deco+  HsQuasiQuote NoExtField _ quoterName srcSpan str -> do+    txt "["+    p_rdrName (L srcSpan quoterName)+    txt "|"+    -- QuasiQuoters often rely on precise custom strings. We cannot do any+    -- formatting here without potentially breaking someone's code.+    atom str+    txt "|]"+  HsSpliced {} -> notImplemented "HsSpliced"+  HsSplicedT {} -> notImplemented "HsSplicedT"+  XSplice x -> noExtCon x++p_hsSpliceTH ::+  -- | Typed splice?+  Bool ->+  -- | Splice expression+  LHsExpr GhcPs ->+  -- | Splice decoration+  SpliceDecoration ->+  R ()+p_hsSpliceTH isTyped expr = \case+  HasParens -> do+    txt decoSymbol+    parens N (located expr (sitcc . p_hsExpr))+  HasDollar -> do+    txt decoSymbol+    located expr (sitcc . p_hsExpr)+  NoParens ->+    located expr (sitcc . p_hsExpr)+  where+    decoSymbol = if isTyped then "$$" else "$"++p_hsBracket :: HsBracket GhcPs -> R ()+p_hsBracket = \case+  ExpBr NoExtField expr -> do+    anns <- getEnclosingAnns+    let name = case anns of+          AnnOpenEQ : _ -> ""+          _ -> "e"+    quote name (located expr p_hsExpr)+  PatBr NoExtField pat -> located pat (quote "p" . p_pat)+  DecBrL NoExtField decls -> quote "d" (p_hsDecls Free decls)+  DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer+  TypBr NoExtField ty -> quote "t" (located ty p_hsType)+  VarBr NoExtField isSingleQuote name -> do+    txt (bool "''" "'" isSingleQuote)+    -- HACK As you can see we use 'noLoc' here to be able to pass name into+    -- 'p_rdrName' since the latter expects a "located" thing. The problem+    -- is that 'VarBr' doesn't provide us with location of the name. This in+    -- turn makes it impossible to detect if there are parentheses around+    -- it, etc. So we have to add parentheses manually assuming they are+    -- necessary for all operators.+    let isOperator =+          all+            (\i -> isPunctuation i || isSymbol i)+            (showOutputable (rdrNameOcc name))+            && not (doesNotNeedExtraParens name)+        wrapper = if isOperator then parens N else id+    wrapper $ p_rdrName (noLoc name)+  TExpBr NoExtField expr -> do+    txt "[||"+    breakpoint'+    located expr p_hsExpr+    breakpoint'+    txt "||]"+  XBracket x -> noExtCon x+  where+    quote :: Text -> R () -> R ()+    quote name body = do+      txt "["+      txt name+      txt "|"+      breakpoint'+      inci $ do+        dontUseBraces body+        breakpoint'+        txt "|]"++-- Print the source text of a string literal while indenting+-- gaps correctly.++p_stringLit :: String -> R ()+p_stringLit src =+  let s = splitGaps src+      singleLine =+        txt $ Text.pack (mconcat s)+      multiLine =+        sitcc $ sep breakpoint (txt . Text.pack) (backslashes s)+   in vlayout singleLine multiLine+  where+    -- Split a string on gaps (backslash delimited whitespaces)+    --+    -- > splitGaps "bar\\  \\fo\\&o" == ["bar", "fo\\&o"]+    splitGaps :: String -> [String]+    splitGaps "" = []+    splitGaps s =+      let -- A backslash and a whitespace starts a "gap"+          p (Just '\\', _, _) = True+          p (_, '\\', Just c) | ghcSpace c = False+          p _ = True+       in case span p (zipPrevNext s) of+            (l, r) ->+              let -- drop the initial '\', any amount of 'ghcSpace', and another '\'+                  r' = drop 1 . dropWhile ghcSpace . drop 1 $ map orig r+               in map orig l : splitGaps r'+    -- GHC's definition of whitespaces in strings+    -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653+    ghcSpace :: Char -> Bool+    ghcSpace c = c <= '\x7f' && is_space c+    -- Add backslashes to the inner side of the strings+    --+    -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"]+    backslashes :: [String] -> [String]+    backslashes (x : y : xs) = (x ++ "\\") : backslashes (('\\' : y) : xs)+    backslashes xs = xs+    -- Attaches previous and next items to each list element+    zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)]+    zipPrevNext xs =+      let z =+            zip+              (zip (Nothing : map Just xs) xs)+              (map Just (tail xs) ++ repeat Nothing)+       in map (\((p, x), n) -> (p, x, n)) z+    orig (_, x, _) = x++----------------------------------------------------------------------------+-- Helpers++-- | Return the wrapping function controlling the use of braces according to+-- the current layout.+layoutToBraces :: Layout -> R () -> R ()+layoutToBraces = \case+  SingleLine -> useBraces+  MultiLine -> id++-- | Append each element in both lists with semigroups. If one list is shorter+-- than the other, return the rest of the longer list unchanged.+liftAppend :: Semigroup a => [a] -> [a] -> [a]+liftAppend [] [] = []+liftAppend [] (y : ys) = y : ys+liftAppend (x : xs) [] = x : xs+liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys++getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan+getGRHSSpan (GRHS NoExtField guards body) =+  combineSrcSpans' $ getLoc body :| map getLoc guards+getGRHSSpan (XGRHS x) = noExtCon x++-- | Place a thing that may have a hanging form. This function handles how+-- to separate it from preceding expressions and whether to bump indentation+-- depending on what sort of expression we have.+placeHanging :: Placement -> R () -> R ()+placeHanging placement m =+  case placement of+    Hanging -> do+      space+      m+    Normal -> do+      breakpoint+      inci m++-- | Check if given block contains single expression which has a hanging+-- form.+blockPlacement ::+  (body -> Placement) ->+  [LGRHS GhcPs (Located body)] ->+  Placement+blockPlacement placer [L _ (GRHS NoExtField _ (L _ x))] = placer x+blockPlacement _ _ = Normal++-- | Check if given command has a hanging form.+cmdPlacement :: HsCmd GhcPs -> Placement+cmdPlacement = \case+  HsCmdLam NoExtField _ -> Hanging+  HsCmdCase NoExtField _ _ -> Hanging+  HsCmdDo NoExtField _ -> Hanging+  _ -> Normal++cmdTopPlacement :: HsCmdTop GhcPs -> Placement+cmdTopPlacement = \case+  HsCmdTop NoExtField (L _ x) -> cmdPlacement x+  XCmdTop x -> noExtCon x++-- | Check if given expression has a hanging form.+exprPlacement :: HsExpr GhcPs -> Placement+exprPlacement = \case+  -- Only hang lambdas with single line parameter lists+  HsLam NoExtField mg -> case mg of+    MG _ (L _ [L _ (Match NoExtField _ (x : xs) _)]) _+      | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) ->+        Hanging+    _ -> Normal+  HsLamCase NoExtField _ -> Hanging+  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)+  HsApp NoExtField _ y -> exprPlacement (unLoc y)+  HsProc NoExtField p _ ->+    -- Indentation breaks if pattern is longer than one line and left+    -- hanging. Consequently, only apply hanging when it is safe.+    if isOneLineSpan (getLoc p)+      then Hanging+      else Normal+  _ -> Normal++withGuards :: [LGRHS GhcPs (Located body)] -> Bool+withGuards = any (checkOne . unLoc)+  where+    checkOne :: GRHS GhcPs (Located body) -> Bool+    checkOne (GRHS NoExtField [] _) = False+    checkOne _ = True++exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)+exprOpTree (L _ (OpApp NoExtField x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)+exprOpTree n = OpNode n++getOpName :: HsExpr GhcPs -> Maybe RdrName+getOpName = \case+  HsVar NoExtField (L _ a) -> Just a+  _ -> Nothing++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+  -- If the beginning of the first argument and the second argument are on+  -- the same line, and the second argument has a hanging form, use hanging+  -- placement.+  let placement =+        if isOneLineSpan+          (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))+          then case y of+            OpNode (L _ n) -> exprPlacement n+            _ -> Normal+          else Normal+      -- Distinguish holes used in infix notation.+      -- eg. '1 _foo 2' and '1 `_foo` 2'+      opWrapper = case unLoc op of+        HsUnboundVar NoExtField _ -> backticks+        _ -> id+  layout <- getLayout+  let ub = case layout of+        SingleLine -> useBraces+        MultiLine -> case placement of+          Hanging -> useBraces+          Normal -> dontUseBraces+      gotDollar = case getOpName (unLoc op) of+        Just rname -> mkVarOcc "$" == rdrNameOcc rname+        _ -> False+      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)+      isSection = case (opTreeLoc x, getLoc op) of+        (RealSrcSpan treeSpan, RealSrcSpan opSpan) ->+          srcSpanEndCol treeSpan /= srcSpanStartCol opSpan+        _ -> False+  useRecordDot' <- useRecordDot+  let isRecordDot' = isRecordDot (unLoc op) (opTreeLoc y)+  if useRecordDot' && isRecordDot'+    then do+      lhs+      when isSection space+      p_op+      p_y+    else+      if isDollarSpecial+        && gotDollar+        && placement+        == Normal+        && isOneLineSpan (opTreeLoc x)+        then do+          useBraces lhs+          space+          p_op+          breakpoint+          inci p_y+        else do+          ub lhs+          placeHanging placement $ do+            p_op+            space+            p_y++-- | Return 'True' if given expression is a record-dot operator expression.+isRecordDot ::+  -- | Operator expression+  HsExpr GhcPs ->+  -- | Span of the expression on the right-hand side of the operator+  SrcSpan ->+  Bool+isRecordDot op (RealSrcSpan ySpan) = case op of+  HsVar NoExtField (L (RealSrcSpan opSpan) opName) ->+    isDot opName && (srcSpanEndCol opSpan == srcSpanStartCol ySpan)+  _ -> False+isRecordDot _ _ = False++-- | Check whether a given 'RdrName' is the dot operator.+isDot :: RdrName -> Bool+isDot name = rdrNameOcc name == mkVarOcc "."++-- | Get annotations for the enclosing element.+getEnclosingAnns :: R [AnnKeywordId]+getEnclosingAnns = do+  e <- getEnclosingSpan (const True)+  case e of+    Nothing -> return []+    Just e' -> getAnns (RealSrcSpan e')
+ src/Ormolu/Printer/Meat/Declaration/Value.hs-boot view
@@ -0,0 +1,21 @@+module Ormolu.Printer.Meat.Declaration.Value+  ( p_valDecl,+    p_pat,+    p_hsExpr,+    p_hsSplice,+    p_stringLit,+  )+where++import GHC+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
@@ -0,0 +1,50 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Warning+  ( p_warnDecls,+    p_moduleWarning,+  )+where++import BasicTypes+import Data.Foldable+import Data.Text (Text)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common++p_warnDecls :: WarnDecls GhcPs -> R ()+p_warnDecls (Warnings NoExtField _ warnings) =+  traverse_ (located' p_warnDecl) warnings+p_warnDecls (XWarnDecls x) = noExtCon x++p_warnDecl :: WarnDecl GhcPs -> R ()+p_warnDecl (Warning NoExtField functions warningTxt) =+  p_topLevelWarning functions warningTxt+p_warnDecl (XWarnDecl x) = noExtCon x++p_moduleWarning :: WarningTxt -> R ()+p_moduleWarning wtxt = do+  let (pragmaText, lits) = warningText wtxt+  inci $ pragma pragmaText $ inci $ p_lits lits++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+      breakpoint+      p_lits lits++warningText :: WarningTxt -> (Text, [Located StringLiteral])+warningText = \case+  WarningTxt _ lits -> ("WARNING", lits)+  DeprecatedTxt _ lits -> ("DEPRECATED", lits)++p_lits :: [Located StringLiteral] -> R ()+p_lits = \case+  [l] -> atom l+  ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls
+ src/Ormolu/Printer/Meat/ImportExport.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of import and export lists.+module Ormolu.Printer.Meat.ImportExport+  ( p_hsmodExports,+    p_hsmodImport,+  )+where++import Control.Monad+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Utils (RelativePos (..), attachRelativePos)++p_hsmodExports :: [LIE GhcPs] -> R ()+p_hsmodExports [] = do+  txt "("+  breakpoint'+  txt ")"+p_hsmodExports xs =+  parens N . sitcc $ do+    layout <- getLayout+    sep+      breakpoint+      (\(p, l) -> sitcc (located l (p_lie layout p)))+      (attachRelativePos xs)++p_hsmodImport :: Bool -> ImportDecl GhcPs -> R ()+p_hsmodImport useQualifiedPost ImportDecl {..} = do+  txt "import"+  space+  when ideclSource (txt "{-# SOURCE #-}")+  space+  when ideclSafe (txt "safe")+  space+  when+    (isImportDeclQualified ideclQualified && not useQualifiedPost)+    (txt "qualified")+  space+  case ideclPkgQual of+    Nothing -> return ()+    Just slit -> atom slit+  space+  inci $ do+    located ideclName atom+    when+      (isImportDeclQualified ideclQualified && useQualifiedPost)+      (space >> txt "qualified")+    case ideclAs of+      Nothing -> return ()+      Just l -> do+        space+        txt "as"+        space+        located l atom+    space+    case ideclHiding of+      Nothing -> return ()+      Just (hiding, _) ->+        when hiding (txt "hiding")+    case ideclHiding of+      Nothing -> return ()+      Just (_, L _ xs) -> do+        breakpoint+        parens N . sitcc $ do+          layout <- getLayout+          sep+            breakpoint+            (\(p, l) -> sitcc (located l (p_lie layout p)))+            (attachRelativePos xs)+    newline+p_hsmodImport _ (XImportDecl x) = noExtCon x++p_lie :: Layout -> RelativePos -> IE GhcPs -> R ()+p_lie encLayout relativePos = \case+  IEVar NoExtField l1 -> do+    located l1 p_ieWrappedName+    p_comma+  IEThingAbs NoExtField l1 -> do+    located l1 p_ieWrappedName+    p_comma+  IEThingAll NoExtField l1 -> do+    located l1 p_ieWrappedName+    space+    txt "(..)"+    p_comma+  IEThingWith NoExtField l1 w xs _ -> sitcc $ do+    located l1 p_ieWrappedName+    breakpoint+    inci $ do+      let names :: [R ()]+          names = located' p_ieWrappedName <$> xs+      parens N . sitcc+        $ sep (comma >> breakpoint) sitcc+        $ case w of+          NoIEWildcard -> names+          IEWildcard n ->+            let (before, after) = splitAt n names+             in before ++ [txt ".."] ++ after+    p_comma+  IEModuleContents NoExtField l1 -> do+    located l1 p_hsmodName+    p_comma+  IEGroup NoExtField n str -> do+    case relativePos of+      SinglePos -> return ()+      FirstPos -> return ()+      MiddlePos -> newline+      LastPos -> newline+    p_hsDocString (Asterisk n) False (noLoc str)+  IEDoc NoExtField str ->+    p_hsDocString Pipe False (noLoc str)+  IEDocNamed NoExtField str -> p_hsDocName str+  XIE x -> noExtCon x+  where+    p_comma =+      case encLayout of+        SingleLine ->+          case relativePos of+            SinglePos -> return ()+            FirstPos -> comma+            MiddlePos -> comma+            LastPos -> return ()+        MultiLine -> comma
+ src/Ormolu/Printer/Meat/Module.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of modules.+module Ormolu.Printer.Meat.Module+  ( p_hsModule,+  )+where++import Control.Monad+import qualified Data.Text as T+import GHC+import Ormolu.Imports+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Pragma+import Ormolu.Parser.Shebang+import Ormolu.Printer.Combinators+import Ormolu.Printer.Comments+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Declaration+import Ormolu.Printer.Meat.Declaration.Warning+import Ormolu.Printer.Meat.ImportExport+import Ormolu.Printer.Meat.Pragma++-- | Render a module.+p_hsModule ::+  -- | Stack header+  Maybe (RealLocated Comment) ->+  -- | Shebangs+  [Shebang] ->+  -- | Pragmas and the associated comments+  [([RealLocated Comment], Pragma)] ->+  -- | Whether to use postfix qualified imports+  Bool ->+  -- | AST to print+  HsModule GhcPs ->+  R ()+p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do+  let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage+      exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports+  switchLayout (deprecSpan <> exportSpans) $ do+    forM_ shebangs $ \(Shebang x) ->+      located x $ \shebang -> do+        txt (T.pack shebang)+        newline+    forM_ mstackHeader $ \(L spn comment) -> do+      spitCommentNow spn comment+      newline+    newline+    p_pragmas pragmas+    newline+    case hsmodName of+      Nothing -> return ()+      Just hsmodName' -> do+        located hsmodName' $ \name -> do+          forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)+          p_hsmodName name+        breakpoint+        forM_ hsmodDeprecMessage $ \w -> do+          located' p_moduleWarning w+          breakpoint+        case hsmodExports of+          Nothing -> return ()+          Just l -> do+            located l $ \exports -> do+              inci (p_hsmodExports exports)+            breakpoint+        txt "where"+        newline+    newline+    forM_ (sortImports hsmodImports) (located' (p_hsmodImport qualifiedPost))+    newline+    switchLayout (getLoc <$> hsmodDecls) $ do+      p_hsDecls Free hsmodDecls+      newline+      spitRemainingComments
+ src/Ormolu/Printer/Meat/Pragma.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- | Pretty-printing of language pragmas.+module Ormolu.Printer.Meat.Pragma+  ( p_pragmas,+  )+where++import Control.Monad+import Data.Char (isUpper)+import qualified Data.List as L+import Data.Maybe (listToMaybe)+import qualified Data.Text as T+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Pragma (Pragma (..))+import Ormolu.Printer.Combinators+import Ormolu.Printer.Comments+import SrcLoc++-- | Pragma classification.+data PragmaTy+  = Language LanguagePragmaClass+  | OptionsGHC+  | OptionsHaddock+  deriving (Eq, Ord)++-- | Language pragma classification.+--+-- The order in which language pragmas are put in the input sometimes+-- matters. This is because some language extensions can enable other+-- extensions, yet the extensions coming later in the list have the ability+-- to change it. So here we classify all extensions by assigning one of the+-- four groups to them. Then we only sort inside of the groups.+--+-- 'Ord' instance of this data type is what affects the sorting.+--+-- See also: <https://github.com/tweag/ormolu/issues/404>+data LanguagePragmaClass+  = -- | All other extensions+    Normal+  | -- | Extensions starting with "No"+    Disabling+  | -- | Extensions that should go after everything else+    Final+  deriving (Eq, Ord)++-- | Print a collection of 'Pragma's with their associated comments.+p_pragmas :: [([RealLocated Comment], Pragma)] -> R ()+p_pragmas ps = do+  let prepare = L.sortOn snd . L.nub . concatMap analyze+      analyze = \case+        (cs, PragmaLanguage xs) ->+          let f x = (cs, (Language (classifyLanguagePragma x), x))+           in f <$> xs+        (cs, PragmaOptionsGHC x) -> [(cs, (OptionsGHC, x))]+        (cs, PragmaOptionsHaddock x) -> [(cs, (OptionsHaddock, x))]+  forM_ (prepare ps) $ \(cs, (pragmaTy, x)) ->+    p_pragma cs pragmaTy x++p_pragma :: [RealLocated Comment] -> PragmaTy -> String -> R ()+p_pragma comments ty x = do+  forM_ comments $ \(L l comment) -> do+    spitCommentNow l comment+    newline+  txt "{-# "+  txt $ case ty of+    Language _ -> "LANGUAGE"+    OptionsGHC -> "OPTIONS_GHC"+    OptionsHaddock -> "OPTIONS_HADDOCK"+  space+  txt (T.pack x)+  txt " #-}"+  newline++-- | Classify a 'LanguagePragma'.+classifyLanguagePragma :: String -> LanguagePragmaClass+classifyLanguagePragma = \case+  "ImplicitPrelude" -> Final+  "CUSKs" -> Final+  str ->+    case splitAt 2 str of+      ("No", rest) ->+        case listToMaybe rest of+          Nothing -> Normal+          Just x ->+            if isUpper x+              then Disabling+              else Normal+      _ -> Normal
+ src/Ormolu/Printer/Meat/Type.hs view
@@ -0,0 +1,279 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of types.+module Ormolu.Printer.Meat.Type+  ( p_hsType,+    p_hsTypePostDoc,+    hasDocStrings,+    p_hsContext,+    p_hsTyVarBndr,+    p_forallBndrs,+    p_conDeclFields,+    tyVarsToTypes,+  )+where++import Data.Data (Data)+import GHC hiding (isPromoted)+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit)+import Ormolu.Printer.Operators+import Ormolu.Utils++p_hsType :: HsType GhcPs -> R ()+p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t++p_hsTypePostDoc :: HsType GhcPs -> R ()+p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t++-- | How to render Haddocks associated with a type.+data TypeDocStyle+  = PipeStyle+  | CaretStyle++p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R ()+p_hsType' multilineArgs docStyle = \case+  HsForAllTy NoExtField visibility bndrs t -> do+    p_forallBndrs visibility p_hsTyVarBndr bndrs+    interArgBreak+    p_hsTypeR (unLoc t)+  HsQualTy NoExtField qs t -> do+    located qs p_hsContext+    space+    txt "=>"+    interArgBreak+    case unLoc t of+      HsQualTy {} -> p_hsTypeR (unLoc t)+      HsFunTy {} -> p_hsTypeR (unLoc t)+      _ -> located t p_hsTypeR+  HsTyVar NoExtField p n -> do+    case p of+      IsPromoted -> do+        txt "'"+        case showOutputable (unLoc n) of+          _ : '\'' : _ -> space+          _ -> return ()+      NotPromoted -> return ()+    p_rdrName n+  HsAppTy NoExtField f x -> do+    let -- In order to format type applications with multiple parameters+        -- nicer, traverse the AST to gather the function and all the+        -- parameters together.+        gatherArgs f' knownArgs =+          case f' of+            L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs)+            _ -> (f', knownArgs)+        (func, args) = gatherArgs f [x]+    switchLayout (getLoc f : fmap getLoc args) $ sitcc $ do+      located func p_hsType+      breakpoint+      inci $+        sep breakpoint (located' p_hsType) args+  HsAppKindTy _ ty kd -> sitcc $ do+    -- The first argument is the location of the "@..." part. Not 100% sure,+    -- but I think we can ignore it as long as we use 'located' on both the+    -- type and the kind.+    located ty p_hsType+    breakpoint+    inci $ do+      txt "@"+      located kd p_hsType+  HsFunTy NoExtField x y@(L _ y') -> do+    located x p_hsType+    space+    txt "->"+    interArgBreak+    case y' of+      HsFunTy {} -> p_hsTypeR y'+      _ -> located y p_hsTypeR+  HsListTy NoExtField t ->+    located t (brackets N . p_hsType)+  HsTupleTy NoExtField tsort xs ->+    let parens' =+          case tsort of+            HsUnboxedTuple -> parensHash N+            HsBoxedTuple -> parens N+            HsConstraintTuple -> parens N+            HsBoxedOrConstraintTuple -> parens N+     in parens' . sitcc $+          sep (comma >> breakpoint) (sitcc . located' p_hsType) xs+  HsSumTy NoExtField xs ->+    parensHash N . sitcc $+      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)+  HsIParamTy NoExtField n t -> sitcc $ do+    located n atom+    space+    txt "::"+    breakpoint+    inci (located t p_hsType)+  HsStarTy NoExtField _ -> txt "*"+  HsKindSig NoExtField t k -> sitcc $ do+    located t p_hsType+    space -- FIXME+    txt "::"+    space+    inci (located k p_hsType)+  HsSpliceTy NoExtField splice -> p_hsSplice splice+  HsDocTy NoExtField t str ->+    case docStyle of+      PipeStyle -> do+        p_hsDocString Pipe True str+        located t p_hsType+      CaretStyle -> do+        located t p_hsType+        newline+        p_hsDocString Caret False str+  HsBangTy NoExtField (HsSrcBang _ u s) t -> do+    case u of+      SrcUnpack -> txt "{-# UNPACK #-}" >> space+      SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space+      NoSrcUnpack -> return ()+    case s of+      SrcLazy -> txt "~"+      SrcStrict -> txt "!"+      NoSrcStrict -> return ()+    located t p_hsType+  HsRecTy NoExtField fields ->+    p_conDeclFields fields+  HsExplicitListTy NoExtField p xs -> do+    case p of+      IsPromoted -> txt "'"+      NotPromoted -> return ()+    brackets N $ do+      -- If both this list itself and the first element is promoted,+      -- we need to put a space in between or it fails to parse.+      case (p, xs) of+        (IsPromoted, L _ t : _) | isPromoted t -> space+        _ -> return ()+      sitcc $ sep (comma >> breakpoint) (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+  HsTyLit NoExtField t ->+    case t of+      HsStrTy (SourceText s) _ -> p_stringLit s+      a -> atom a+  HsWildCardTy NoExtField -> txt "_"+  XHsType (NHsCoreTy t) -> atom t+  where+    isPromoted = \case+      HsTyVar _ IsPromoted _ -> True+      HsExplicitTupleTy {} -> True+      HsExplicitListTy {} -> True+      _ -> False+    interArgBreak =+      if multilineArgs+        then newline+        else breakpoint+    p_hsTypeR = p_hsType' multilineArgs docStyle++-- | Return 'True' if at least one argument in 'HsType' has a doc string+-- attached to it.+hasDocStrings :: HsType GhcPs -> Bool+hasDocStrings = \case+  HsDocTy {} -> True+  HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y+  _ -> False++p_hsContext :: HsContext GhcPs -> R ()+p_hsContext = \case+  [] -> txt "()"+  [x] -> located x p_hsType+  xs ->+    parens N . sitcc $+      sep (comma >> breakpoint) (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+    located l atom+    space+    txt "::"+    breakpoint+    inci (located k p_hsType)+  XTyVarBndr x -> noExtCon x++-- | Render several @forall@-ed variables.+p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R ()+p_forallBndrs ForallInvis _ [] = txt "forall."+p_forallBndrs ForallVis _ [] = txt "forall ->"+p_forallBndrs vis p tyvars =+  switchLayout (getLoc <$> tyvars) $ do+    txt "forall"+    breakpoint+    inci $ do+      sitcc $ sep breakpoint (sitcc . located' p) tyvars+      case vis of+        ForallInvis -> txt "."+        ForallVis -> space >> txt "->"++p_conDeclFields :: [LConDeclField GhcPs] -> R ()+p_conDeclFields xs =+  braces N . sitcc $+    sep (comma >> breakpoint) (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)+      (located' (p_rdrName . rdrNameFieldOcc))+      cd_fld_names+  space+  txt "::"+  breakpoint+  sitcc . inci $ p_hsType (unLoc cd_fld_type)+p_conDeclField (XConDeclField x) = noExtCon x++tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)+tyOpTree (L _ (HsOpTy NoExtField l op r)) =+  OpBranch (tyOpTree l) op (tyOpTree r)+tyOpTree n = OpNode n++p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R ()+p_tyOpTree (OpNode n) = located n p_hsType+p_tyOpTree (OpBranch l op r) = do+  switchLayout [opTreeLoc l] $+    p_tyOpTree l+  breakpoint+  inci . switchLayout [opTreeLoc r] $ do+    p_rdrName op+    space+    p_tyOpTree r++----------------------------------------------------------------------------+-- Conversion functions++tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]+tyVarsToTypes = \case+  HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit+  XLHsQTyVars x -> noExtCon x++tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs+tyVarToType = \case+  UserTyVar NoExtField tvar -> HsTyVar NoExtField NotPromoted tvar+  KindedTyVar NoExtField tvar kind ->+    -- Note: we always add parentheses because for whatever reason GHC does+    -- not use HsParTy for left-hand sides of declarations. Please see+    -- <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 $+      HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind+  XTyVarBndr x -> noExtCon x
+ src/Ormolu/Printer/Operators.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | This module helps handle operator chains composed of different+-- operators that may have different precedence and fixities.+module Ormolu.Printer.Operators+  ( OpTree (..),+    opTreeLoc,+    reassociateOpTree,+  )+where++import Data.Function (on)+import qualified Data.List as L+import Data.Maybe (fromMaybe, mapMaybe)+import Data.Ord (Down (Down), comparing)+import GHC+import OccName (mkVarOcc)+import Ormolu.Utils (unSrcSpan)++-- | Intermediate representation of operator trees. It has two type+-- parameters: @ty@ is the type of sub-expressions, while @op@ is the type+-- of operators.+data OpTree ty op+  = OpNode ty+  | OpBranch+      (OpTree ty op)+      op+      (OpTree ty op)++-- | Return combined 'SrcSpan's of all elements in this 'OpTree'.+opTreeLoc :: OpTree (Located a) b -> SrcSpan+opTreeLoc (OpNode (L l _)) = l+opTreeLoc (OpBranch l _ r) = combineSrcSpans (opTreeLoc l) (opTreeLoc r)++-- | Re-associate an 'OpTree' taking into account automagically inferred+-- relative precedence of operators. Users are expected to first construct+-- an initial 'OpTree', then re-associate it using this function before+-- printing.+reassociateOpTree ::+  -- | How to get name of an operator+  (op -> Maybe RdrName) ->+  -- | Original 'OpTree'+  OpTree (Located ty) (Located op) ->+  -- | Re-associated 'OpTree'+  OpTree (Located ty) (Located op)+reassociateOpTree getOpName opTree =+  reassociateOpTreeWith+    (buildFixityMap getOpName normOpTree)+    (getOpName . unLoc)+    normOpTree+  where+    normOpTree = normalizeOpTree opTree++-- | Re-associate an 'OpTree' given the map with operator fixities.+reassociateOpTreeWith ::+  forall ty op.+  -- | Fixity map for operators+  [(RdrName, Fixity)] ->+  -- | How to get the name of an operator+  (op -> Maybe RdrName) ->+  -- | Original 'OpTree'+  OpTree ty op ->+  -- | Re-associated 'OpTree'+  OpTree ty op+reassociateOpTreeWith fixityMap getOpName = go+  where+    fixityOf :: op -> Fixity+    fixityOf op = fromMaybe defaultFixity $ do+      opName <- getOpName op+      lookup opName fixityMap+    -- Here, left branch is already associated and the root alongside with+    -- the right branch is right-associated. This function picks up one item+    -- from the right and inserts it correctly to the left.+    --+    -- Also, we are using the 'compareFixity' function which returns if the+    -- expression should associate to right.+    go :: OpTree ty op -> OpTree ty op+    -- base cases+    go t@(OpNode _) = t+    go t@(OpBranch (OpNode _) _ (OpNode _)) = t+    -- shift one operator to the left at the beginning+    go (OpBranch l@(OpNode _) op (OpBranch l' op' r')) =+      go (OpBranch (OpBranch l op l') op' r')+    -- at the last operator, place the operator and don't recurse+    go (OpBranch (OpBranch l op r) op' r'@(OpNode _)) =+      if snd $ compareFixity (fixityOf op) (fixityOf op')+        then OpBranch l op (go $ OpBranch r op' r')+        else OpBranch (OpBranch l op r) op' r'+    -- else, shift one operator to left and recurse.+    go (OpBranch (OpBranch l op r) op' (OpBranch l' op'' r')) =+      if snd $ compareFixity (fixityOf op) (fixityOf op')+        then go $ OpBranch (OpBranch l op (go $ OpBranch r op' l')) op'' r'+        else go $ OpBranch (OpBranch (OpBranch l op r) op' l') op'' r'++-- | Build a map of inferred 'Fixity's from an 'OpTree'.+buildFixityMap ::+  forall ty op.+  -- | How to get the name of an operator+  (op -> Maybe RdrName) ->+  -- | Operator tree+  OpTree (Located ty) (Located op) ->+  -- | Fixity map+  [(RdrName, Fixity)]+buildFixityMap getOpName opTree =+  concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns)+    . zip [0 ..]+    . L.groupBy (doubleWithinEps 0.00001 `on` snd)+    . (overrides ++)+    . modeScores+    $ score opTree+  where+    -- Add a special case for ($), since it is pretty unlikely for someone+    -- to override it.+    overrides :: [(RdrName, Double)]+    overrides =+      [ (mkRdrUnqual $ mkVarOcc "$", -1)+      ]+    -- Assign scores to operators based on their location in the source.+    score :: OpTree (Located ty) (Located op) -> [(RdrName, Double)]+    score (OpNode _) = []+    score (OpBranch l o r) = fromMaybe (score r) $ do+      -- If we fail to get any of these, 'defaultFixity' will be used by+      -- 'reassociateOpTreeWith'.+      le <- srcSpanEndLine <$> unSrcSpan (opTreeLoc l) -- left end+      ob <- srcSpanStartLine <$> unSrcSpan (getLoc o) -- operator begin+      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)+      let s+            | le < ob =+              -- if the operator is in the beginning of a line, assign+              -- a score relative to its column within range [0, 1).+              fromIntegral oc / fromIntegral (maxCol + 1)+            | oe < rb =+              -- if the operator is in the end of the line, assign the+              -- score 1.+              1+            | otherwise =+              2 -- otherwise, assign a high score.+      return $ (opName, s) : score r+    -- Pick the most common score per 'RdrName'.+    modeScores :: [(RdrName, Double)] -> [(RdrName, Double)]+    modeScores =+      L.sortOn snd+        . mapMaybe+          ( \case+              [] -> Nothing+              xs@((n, _) : _) -> Just (n, mode $ map snd xs)+          )+        . L.groupBy ((==) `on` fst)+        . L.sort+    -- Return the most common number, leaning to the smaller+    -- one in case of a tie.+    mode :: [Double] -> Double+    mode =+      head+        . L.minimumBy (comparing (Down . length))+        . L.groupBy (doubleWithinEps 0.0001)+        . L.sort+    -- The start column of the rightmost operator.+    maxCol = go opTree+      where+        go (OpNode (L _ _)) = 0+        go (OpBranch l (L o _) r) =+          maximum+            [ go l,+              maybe 0 srcSpanStartCol (unSrcSpan o),+              go r+            ]++----------------------------------------------------------------------------+-- Helpers++-- | Convert an 'OpTree' to with all operators having the same fixity and+-- associativity (left infix).+normalizeOpTree :: OpTree ty op -> OpTree ty op+normalizeOpTree (OpNode n) =+  OpNode n+normalizeOpTree (OpBranch (OpNode l) lop r) =+  OpBranch (OpNode l) lop (normalizeOpTree r)+normalizeOpTree (OpBranch (OpBranch l' lop' r') lop r) =+  normalizeOpTree (OpBranch l' lop' (OpBranch r' lop r))++fixity :: Int -> FixityDirection -> Fixity+fixity = Fixity NoSourceText++doubleWithinEps :: Double -> Double -> Double -> Bool+doubleWithinEps eps a b = abs (a - b) < eps
+ src/Ormolu/Printer/SpanStream.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++-- | Build span stream from AST.+module Ormolu.Printer.SpanStream+  ( SpanStream (..),+    mkSpanStream,+  )+where++import Data.DList (DList)+import qualified Data.DList as D+import Data.Data (Data)+import Data.Generics (everything, ext2Q)+import Data.List (sortOn)+import Data.Typeable (cast)+import SrcLoc++-- | A stream of 'RealSrcSpan's in ascending order. This allows us to tell+-- e.g. whether there is another \"located\" element of AST between current+-- element and comment we're considering for printing.+newtype SpanStream = SpanStream [RealSrcSpan]+  deriving (Eq, Show, Data, Semigroup, Monoid)++-- | Create 'SpanStream' from a data structure containing \"located\"+-- elements.+mkSpanStream ::+  Data a =>+  -- | Data structure to inspect (AST)+  a ->+  SpanStream+mkSpanStream a =+  SpanStream+    . sortOn realSrcSpanStart+    . D.toList+    $ everything mappend (const mempty `ext2Q` queryLocated) a+  where+    queryLocated ::+      (Data e0) =>+      GenLocated e0 e1 ->+      DList RealSrcSpan+    queryLocated (L mspn _) =+      case cast mspn :: Maybe SrcSpan of+        Nothing -> mempty+        Just (UnhelpfulSpan _) -> mempty+        Just (RealSrcSpan spn) -> D.singleton spn
+ src/Ormolu/Processing/Common.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Common definitions for pre- and post- processing.+module Ormolu.Processing.Common+  ( OrmoluState (..),+    startDisabling,+    endDisabling,+  )+where++import Data.String (IsString (..))++-- | Ormolu state.+data OrmoluState+  = -- | Enabled+    OrmoluEnabled+  | -- | Disabled+    OrmoluDisabled+  deriving (Eq, Show)++-- | Marker for the beginning of the region where Ormolu should be disabled.+startDisabling :: IsString s => s+startDisabling = "{- ORMOLU_DISABLING_START"++-- | Marker for the end of the region where Ormolu should be disabled.+endDisabling :: IsString s => s+endDisabling = "ORMOLU_DISABLE_END -}"
+ src/Ormolu/Processing/Cpp.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Support for CPP.+module Ormolu.Processing.Cpp+  ( State (..),+    processLine,+    unmaskLine,+  )+where++import Control.Monad+import Data.Char (isSpace)+import qualified Data.List as L+import Data.Maybe (isJust)+import Data.String+import Data.Text (Text)+import qualified Data.Text as T++-- | State of the CPP processor.+data State+  = -- | Outside of CPP directives+    Outside+  | -- | In a conditional expression+    InConditional+  | -- | In a continuation (after @\\@)+    InContinuation+  deriving (Eq, Show)++-- | Automatically mask the line when needed and update the 'State'.+processLine :: String -> State -> (String, State)+processLine line state+  | for "define " = (masked, state')+  | for "include " = (masked, state')+  | for "undef " = (masked, state')+  | for "ifdef " = (masked, InConditional)+  | for "ifndef " = (masked, InConditional)+  | for "if " = (masked, InConditional)+  | for "else" = (masked, InConditional)+  | for "elif" = (masked, InConditional)+  | for "endif" = (masked, state')+  | otherwise =+    case state of+      Outside -> (line, Outside)+      InConditional -> (masked, InConditional)+      InContinuation -> (masked, state')+  where+    for directive = isJust $ do+      s <- dropWhile isSpace <$> L.stripPrefix "#" line+      void (L.stripPrefix directive s)+    masked = maskLine line+    state' =+      if "\\" `L.isSuffixOf` line+        then InContinuation+        else Outside++-- | Mask the given line.+maskLine :: String -> String+maskLine x = maskPrefix ++ x++-- | If the given line is masked, unmask it. Otherwise return the line+-- unchanged.+unmaskLine :: Text -> Text+unmaskLine x =+  case T.stripPrefix maskPrefix (T.stripStart x) of+    Nothing -> x+    Just x' -> x'++-- | Mask prefix for CPP.+maskPrefix :: IsString s => s+maskPrefix = "-- ORMOLU_CPP_MASK"
+ src/Ormolu/Processing/Postprocess.hs view
@@ -0,0 +1,21 @@+-- | Postprocessing for the results of printing.+module Ormolu.Processing.Postprocess+  ( postprocess,+  )+where++import Data.Text (Text)+import qualified Data.Text as T+import Ormolu.Processing.Common+import qualified Ormolu.Processing.Cpp as Cpp++-- | Postprocess output of the formatter.+postprocess :: Text -> Text+postprocess =+  T.unlines+    . fmap Cpp.unmaskLine+    . filter (not . magicComment)+    . T.lines+  where+    magicComment x =+      x == startDisabling || x == endDisabling
+ src/Ormolu/Processing/Preprocess.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++-- | Preprocessing for input source code.+module Ormolu.Processing.Preprocess+  ( preprocess,+  )+where++import Control.Monad+import Data.Char (isSpace)+import qualified Data.List as L+import Data.Maybe (isJust)+import Data.Maybe (maybeToList)+import FastString+import Ormolu.Config (RegionDeltas (..))+import Ormolu.Parser.Shebang (isShebang)+import Ormolu.Processing.Common+import qualified Ormolu.Processing.Cpp as Cpp+import SrcLoc++-- | Transform given input possibly returning comments extracted from it.+-- This handles LINE pragmas, CPP, shebangs, and the magic comments for+-- enabling\/disabling of Ormolu.+preprocess ::+  -- | File name, just to use in the spans+  FilePath ->+  -- | Input to process+  String ->+  -- | Region deltas+  RegionDeltas ->+  -- | Literal prefix, pre-processed input, literal suffix, extra comments+  (String, String, String, [Located String])+preprocess path input RegionDeltas {..} =+  go 1 OrmoluEnabled Cpp.Outside id id regionLines+  where+    (prefixLines, otherLines) = splitAt regionPrefixLength (lines input)+    (regionLines, suffixLines) =+      let regionLength = length otherLines - regionSuffixLength+       in splitAt regionLength otherLines+    go !n ormoluState cppState inputSoFar csSoFar = \case+      [] ->+        let input' = unlines (inputSoFar [])+         in ( unlines prefixLines,+              case ormoluState of+                OrmoluEnabled -> input'+                OrmoluDisabled -> input' ++ endDisabling,+              unlines suffixLines,+              csSoFar []+            )+      (x : xs) ->+        let (x', ormoluState', cppState', cs) =+              processLine path n ormoluState cppState x+         in go+              (n + 1)+              ormoluState'+              cppState'+              (inputSoFar . (x' :))+              (csSoFar . (maybeToList cs ++))+              xs++-- | Transform a given line possibly returning a comment extracted from it.+processLine ::+  -- | File name, just to use in the spans+  FilePath ->+  -- | Line number of this line+  Int ->+  -- | Whether Ormolu is currently enabled+  OrmoluState ->+  -- | CPP state+  Cpp.State ->+  -- | The actual line+  String ->+  -- | Adjusted line and possibly a comment extracted from it+  (String, OrmoluState, Cpp.State, Maybe (Located String))+processLine path n ormoluState Cpp.Outside line+  | "{-# LINE" `L.isPrefixOf` line =+    let (pragma, res) = getPragma line+        size = length pragma+        ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))+     in (res, ormoluState, Cpp.Outside, Just (L ss pragma))+  | isOrmoluEnable line =+    case ormoluState of+      OrmoluEnabled ->+        (enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)+      OrmoluDisabled ->+        (endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing)+  | isOrmoluDisable line =+    case ormoluState of+      OrmoluEnabled ->+        (disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing)+      OrmoluDisabled ->+        (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing)+  | isShebang line =+    let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line))+     in ("", ormoluState, Cpp.Outside, Just (L ss line))+  | otherwise =+    let (line', cppState') = Cpp.processLine line Cpp.Outside+     in (line', ormoluState, cppState', Nothing)+  where+    mkSrcLoc' = mkSrcLoc (mkFastString path) n+processLine _ _ ormoluState cppState line =+  let (line', cppState') = Cpp.processLine line cppState+   in (line', ormoluState, cppState', Nothing)++-- | Take a line pragma and output its replacement (where line pragma is+-- replaced with spaces) and the contents of the pragma itself.+getPragma ::+  -- | Pragma line to analyze+  String ->+  -- | Contents of the pragma and its replacement line+  (String, String)+getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty"+getPragma s@(x : xs)+  | "#-}" `L.isPrefixOf` s = ("#-}", "   " ++ drop 3 s)+  | otherwise =+    let (prag, remline) = getPragma xs+     in (x : prag, ' ' : remline)++-- | Canonical enable marker.+enableMarker :: String+enableMarker = "{- ORMOLU_ENABLE -}"++-- | Canonical disable marker.+disableMarker :: String+disableMarker = "{- ORMOLU_DISABLE -}"++-- | Return 'True' if the given string is an enabling marker.+isOrmoluEnable :: String -> Bool+isOrmoluEnable = magicComment "ORMOLU_ENABLE"++-- | Return 'True' if the given string is a disabling marker.+isOrmoluDisable :: String -> Bool+isOrmoluDisable = magicComment "ORMOLU_DISABLE"++-- | Construct a function for whitespace-insensitive matching of string.+magicComment ::+  -- | What to expect+  String ->+  -- | String to test+  String ->+  -- | 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+  s3 <- L.stripPrefix "-}" s2+  guard (all isSpace s3)
+ src/Ormolu/Utils.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Random utilities used by the code.+module Ormolu.Utils+  ( RelativePos (..),+    attachRelativePos,+    combineSrcSpans',+    notImplemented,+    showOutputable,+    splitDocString,+    typeArgToType,+    unSrcSpan,+    incSpanLine,+    separatedByBlank,+    separatedByBlankNE,+    onTheSameLine,+  )+where++import Data.List (dropWhileEnd)+import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import qualified Data.Text as T+import GHC+import GHC.DynFlags (baseDynFlags)+import qualified Outputable as GHC++-- | Relative positions in a list.+data RelativePos+  = SinglePos+  | FirstPos+  | MiddlePos+  | LastPos+  deriving (Eq, Show)++-- | Attach 'RelativePos'es to elements of a given list.+attachRelativePos :: [a] -> [(RelativePos, a)]+attachRelativePos = \case+  [] -> []+  [x] -> [(SinglePos, x)]+  (x : xs) -> (FirstPos, x) : markLast xs+  where+    markLast [] = []+    markLast [x] = [(LastPos, x)]+    markLast (x : xs) = (MiddlePos, x) : markLast xs++-- | Combine all source spans from the given list.+combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan+combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs++-- | Placeholder for things that are not yet implemented.+notImplemented :: String -> a+notImplemented msg = error $ "not implemented yet: " ++ msg++-- | Pretty-print an 'GHC.Outputable' thing.+showOutputable :: GHC.Outputable o => o -> String+showOutputable = GHC.showSDoc baseDynFlags . GHC.ppr++-- | Split and normalize a doc string. The result is a list of lines that+-- make up the comment.+splitDocString :: HsDocString -> [Text]+splitDocString docStr =+  case r of+    [] -> [""]+    _ -> r+  where+    r =+      fmap escapeLeadingDollar+        . dropPaddingSpace+        . dropWhileEnd T.null+        . fmap (T.stripEnd . T.pack)+        . lines+        $ unpackHDS docStr+    -- We cannot have the first character to be a dollar because in that+    -- case it'll be a parse error (apparently collides with named docs+    -- syntax @-- $name@ somehow).+    escapeLeadingDollar txt =+      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++-- | Get 'LHsType' out of 'LHsTypeArg'.+typeArgToType :: LHsTypeArg p -> LHsType p+typeArgToType = \case+  HsValArg tm -> tm+  HsTypeArg _ ty -> ty+  HsArgPar _ -> notImplemented "HsArgPar"++-- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”.+unSrcSpan :: SrcSpan -> Maybe RealSrcSpan+unSrcSpan = \case+  RealSrcSpan r -> Just r+  UnhelpfulSpan _ -> Nothing++-- | Increment line number in a 'SrcSpan'.+incSpanLine :: Int -> SrcSpan -> SrcSpan+incSpanLine i = \case+  RealSrcSpan s ->+    let start = realSrcSpanStart s+        end = realSrcSpanEnd s+        incLine x =+          let file = srcLocFile x+              line = srcLocLine x+              col = srcLocCol x+           in mkRealSrcLoc file (line + i) col+     in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end))+  UnhelpfulSpan x -> UnhelpfulSpan x++-- | Do two declarations have a blank between them?+separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool+separatedByBlank loc a b =+  fromMaybe False $ do+    endA <- srcSpanEndLine <$> unSrcSpan (loc a)+    startB <- srcSpanStartLine <$> unSrcSpan (loc b)+    pure (startB - endA >= 2)++-- | Do two declaration groups have a blank between them?+separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool+separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b)++-- | Return 'True' if one span ends on the same line the second one starts.+onTheSameLine :: SrcSpan -> SrcSpan -> Bool+onTheSameLine a b =+  isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b))
+ tests/Ormolu/Parser/PragmaSpec.hs view
@@ -0,0 +1,26 @@+module Ormolu.Parser.PragmaSpec (spec) where++import Ormolu.Parser.Pragma+import Test.Hspec++spec :: Spec+spec =+  describe "parsePragma" $ do+    stdTest "{-# LANGUAGE Foo #-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-# language Foo #-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-#LANGUAGE Foo#-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-# LANGUAGE Foo#-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-#language Foo#-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-# lAngUAGe Foo #-}" (Just (PragmaLanguage ["Foo"]))+    stdTest "{-# LANGUAGE Foo, Bar #-}" (Just (PragmaLanguage ["Foo", "Bar"]))+    stdTest "{-# LANGUAGE Foo Bar #-}" Nothing+    stdTest "{-# BOO Foo #-}" Nothing+    stdTest "something" Nothing+    stdTest "{-# LANGUAGE foo, Bar #-}" Nothing+    stdTest "{-# OPTIONS_GHC foo bar baz  #-}" (Just $ PragmaOptionsGHC "foo bar baz")+    stdTest "{-#OPTIONS_HADDOCK foo, bar, baz  #-}" (Just $ PragmaOptionsHaddock "foo, bar, baz")++stdTest :: String -> Maybe Pragma -> Spec+stdTest input result =+  it input $+    parsePragma input `shouldBe` result
+ tests/Ormolu/PrinterSpec.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE TemplateHaskell #-}++module Ormolu.PrinterSpec (spec) where++import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.List (isSuffixOf)+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Ormolu+import Path+import Path.IO+import qualified System.FilePath as F+import Test.Hspec++spec :: Spec+spec = do+  es <- runIO locateExamples+  forM_ es checkExample++-- | Check a single given example.+checkExample :: Path Rel File -> Spec+checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do+  let srcPath = examplesDir </> srcPath'+  expectedOutputPath <- deriveOutput 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+  -- 'ormoluFile' automatically.)+  formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)+  -- 3. Check the output against expected output. Thus all tests should+  -- include two files: input and expected output.+  -- T.writeFile (fromRelFile expectedOutputPath) formatted0+  expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath+  shouldMatch False formatted0 expected+  -- 4. Check that running the formatter on the output produces the same+  -- output again (the transformation is idempotent).+  formatted1 <- ormolu defaultConfig "<formatted>" (T.unpack formatted0)+  shouldMatch True formatted1 formatted0++-- | Build list of examples for testing.+locateExamples :: IO [Path Rel File]+locateExamples =+  filter isInput . snd <$> listDirRecurRel examplesDir++-- | Does given path look like input path (as opposed to expected output+-- path)?+isInput :: Path Rel File -> Bool+isInput path =+  let s = fromRelFile path+      (s', exts) = F.splitExtensions s+   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 =+  parseRelFile $+    F.addExtension (F.dropExtensions (fromRelFile path) ++ "-out") "hs"++-- | A version of 'shouldBe' that is specialized to comparing 'Text' values.+-- It also prints multi-line snippets in a more readable form.+shouldMatch :: Bool -> Text -> Text -> Expectation+shouldMatch idempotenceTest actual expected =+  when (actual /= expected) . expectationFailure $+    unlines+      [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):",+        T.unpack expected,+        ">>>>>>>>>>>>>>>>>>>>>> but got:",+        T.unpack actual+      ]+  where+    pass =+      if idempotenceTest+        then "idempotence pass"+        else "first pass"++examplesDir :: Path Rel Dir+examplesDir = $(mkRelDir "data/examples")++-- | Inside this wrapper 'OrmoluException' will be caught and displayed+-- nicely using 'displayException'.+withNiceExceptions ::+  -- | Action that may throw the exception+  Expectation ->+  Expectation+withNiceExceptions m = m `catch` h+  where+    h :: OrmoluException -> IO ()+    h = expectationFailure . displayException
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}