packages feed

ormolu (empty) → 0.0.1.0

raw patch · 626 files changed

+13358/−0 lines, 626 filesdep +basedep +bytestringdep +containerssetup-changed

Dependencies added: base, bytestring, containers, dlist, exceptions, filepath, ghc, ghc-boot-th, ghc-paths, gitrev, hspec, mtl, optparse-applicative, ormolu, path, path-io, syb, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 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.+* Idempotency 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;+* 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++Formatting a module which uses CPP directives won't be supported. Instead,+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+produces the same output we would get if the CPP directives were+considered comments:++```+$ hindent --version+hindent 5.2.7++$ hindent 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.++Therefore, CPP won't be supported. If the CPP extension+is enabled, we should signal an error right away.++### 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–present Tweag I/O++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,133 @@+# Ormolu++[![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)+[![CircleCI](https://circleci.com/gh/tweag/ormolu/tree/master.svg?style=svg&circle-token=cfd37a39265561eb44e608f97cf953cb2a394c03)](https://circleci.com/gh/tweag/ormolu/tree/master)++Ormolu 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.+* 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+```++## Current limitations++* Does not handle CPP (wontfix, see [the design document][design]).+* 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:++* [For Emacs][emacs-package]++## 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.md).++## License++See [LICENSE.md](./LICENSE.md).++Copyright © 2018–present Tweag I/O++[design]: ./DESIGN.md#cpp+[haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts+[emacs-package]: https://github.com/vyorkin/ormolu.el
+ 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,168 @@+{-# LANGUAGE CPP             #-}+{-# LANGUAGE LambdaCase      #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}++module Main (main) where++import Control.Monad+import Data.List (intercalate, sort)+import Data.Version (showVersion)+import Development.GitRev+import Options.Applicative+import Ormolu+import Ormolu.Parser (manualExts)+import Ormolu.Utils (showOutputable)+import Paths_ormolu (version)+import System.Exit (ExitCode (..), exitWith)+import System.IO (hPutStrLn, stderr)+import qualified Data.Text.IO as TIO++-- | 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+    xs -> mapM_ (formatOne' . Just) xs++-- | Format a single input.++formatOne+  :: Mode                       -- ^ Mode of operation+  -> Config                     -- ^ Configuration+  -> Maybe FilePath             -- ^ File to format or stdin as 'Nothing'+  -> 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+  { optMode :: !Mode+    -- ^ Mode of operation+  , optConfig :: !Config+    -- ^ Ormolu 'Config'+  , optInputFiles :: ![FilePath]+    -- ^ Haskell source files to format or stdin (when the list is empty)+  }++-- | Mode of operation.++data Mode+  = Stdout                      -- ^ Output formatted source code to stdout+  | InPlace                     -- ^ Overwrite original file+  | Check                       -- ^ Exit with non-zero status code if+                                -- source is not already formatted+  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 " ++ VERSION_ghc+      ]+    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+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 "tolerate-cpp"+    , short 'p'+    , help "Do not fail if CPP pragma is present"+    ]+  <*> (switch . mconcat)+    [ long "check-idempotency"+    , short 'c'+    , help "Fail if formatting is not idempotent"+    ]++----------------------------------------------------------------------------+-- 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,21 @@+{-# 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,14 @@+{-# 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,20 @@+{-# 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,28 @@+{-# 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,14 @@+{-# 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,21 @@+{-# 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,27 @@+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,26 @@+{-# 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,10 @@+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,27 @@+{-# 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,18 @@+{-# 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,20 @@+{-# 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/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,28 @@+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/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,5 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo+  = forall a. MkFoo a (a -> Bool)+  | forall a. Eq a => MkBar a
+ data/examples/declaration/data/existential-multiline.hs view
@@ -0,0 +1,5 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo+  = forall a. MkFoo a (a -> Bool)+  | forall a. Eq a => MkBar a
+ data/examples/declaration/data/existential-out.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo = forall a. MkFoo a (a -> Bool)
+ data/examples/declaration/data/existential.hs view
@@ -0,0 +1,3 @@+{-# LANGUAGE ExistentialQuantification #-}++data Foo = forall a. MkFoo a (a -> Bool)
+ 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.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,2 @@+data Foo a where+  Foo :: !Int -> {-# UNPACK #-} !Bool -> Foo Int
+ data/examples/declaration/data/gadt/strictness.hs view
@@ -0,0 +1,2 @@+data Foo a where+  Foo :: !Int -> {-# UNPACK #-} !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,3 @@+data Something (n :: Nat) = Something++data Format (k :: *) (k' :: *) (k'' :: *)
+ data/examples/declaration/data/kind-annotations.hs view
@@ -0,0 +1,3 @@+data Something (n :: Nat) = Something++data Format (k :: *) (k' :: *) (k'' :: *)
+ 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/record-out.hs view
@@ -0,0 +1,24 @@+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,10 @@+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,4 @@+module Main where++-- | Something.+data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String
+ data/examples/declaration/data/strictness.hs view
@@ -0,0 +1,5 @@+module Main where++-- | Something.++data Foo = Foo !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String
+ 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,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-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,19 @@+{-# 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,19 @@+{-# 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,14 @@+{-# 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,13 @@+{-# 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,11 @@+{-# 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,7 @@+{-# 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,12 @@+{-# 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,7 @@+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/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,11 @@+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-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.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/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,16 @@+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,18 @@+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,15 @@+functionName ::+  (C1, C2, C3, C4, C5) =>+  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,15 @@+functionName+  :: (C1, C2, C3, C4, C5)+  => 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,10 @@+foo, bar :: Int+foo = 1+bar = 2++foo,+  bar,+  baz ::+    Int+bar = 2+baz = 3
+ data/examples/declaration/signature/type/multi-value.hs view
@@ -0,0 +1,9 @@+foo, bar :: Int+foo = 1+bar = 2++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/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,18 @@+{-# 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,24 @@+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/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/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/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/value/function/application-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.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/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/expression-applications-out.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE Arrows #-}++foo x y = x -< y++bar f x =+  f x -< -- Hello+    x -- World++baz x y = x -<< y
+ data/examples/declaration/value/function/arrow/expression-applications.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE Arrows #-}++foo x y = x -< y++bar f x+    =  f x  -- Hello+    -< x    -- World++baz x y = x -<< y
+ data/examples/declaration/value/function/arrow/expression-forms-out.hs view
@@ -0,0 +1,14 @@+{-# LANGUAGE Arrows #-}++foo f g x y = (| test (f -< x) (g -< y) |)++bar f g x y =+  (|+    test+      ( f -<+          x+      )+      ( g -<+          y+      )+  |)
+ data/examples/declaration/value/function/arrow/expression-forms.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE Arrows #-}++foo f g x y = (| test (f -< x) (g -< y) |)++bar f g x y = (|+    test+      (f+       -< x)+      (g+       -< y)+  |)
+ data/examples/declaration/value/function/arrow/proc-applications-out.hs view
@@ -0,0 +1,18 @@+{-# 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,58 @@+{-# 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,17 @@+{-# 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,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-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,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-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,18 @@+{-# 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,13 @@+{-# 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,18 @@+{-# 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,19 @@+{-# 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/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,29 @@+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
+ data/examples/declaration/value/function/block-arguments.hs view
@@ -0,0 +1,25 @@+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
+ 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,18 @@+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/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,14 @@+{-# 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/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,18 @@+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
+ data/examples/declaration/value/function/infix/dollar-chains.hs view
@@ -0,0 +1,18 @@+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
+ 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,11 @@+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,10 @@+{-# LANGUAGE MultiWayIf #-}++foo x = if | x == 5 -> 5++bar x y =+  if+    | x > y -> x+    | x < y ->+      y+    | otherwise -> x
+ data/examples/declaration/value/function/multi-way-if.hs view
@@ -0,0 +1,9 @@+{-# LANGUAGE MultiWayIf #-}++foo x = if | x == 5 -> 5++bar x y = if+    | x > y -> x+    |  x < y+        -> y+    | otherwise  -> 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-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/overindentation-out.hs view
@@ -0,0 +1,9 @@+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,18 @@+{-# 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++-- https://github.com/tweag/ormolu/issues/343+foo = (f -> 4)
+ data/examples/declaration/value/function/pattern/view-pattern.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++-- https://github.com/tweag/ormolu/issues/343+foo = (f -> 4)
+ 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/record-constructors-out.hs view
@@ -0,0 +1,27 @@+foo = Foo {a = 3}++bar = Bar+  { abc = foo,+    def = Foo {a = 10}+  }++baz = Baz {}++sym = Foo {(+) = 3}++aLongVariableName =+  ALongRecordName+    { short = baz,+      aLongRecordFieldName = YetAnotherLongRecordName+        { yetAnotherLongRecordFieldName = "a long string"+        },+      aLongRecordFieldName2 = Just YetAnotherLongRecordName+        { yetAnotherLongRecordFieldName = "a long string",+          yetAnotherLongRecordFieldName =+            Just+              "a long string"+        },+      aLongRecordFieldName3 = do+        foo+        bar+    }
+ data/examples/declaration/value/function/record-constructors.hs view
@@ -0,0 +1,22 @@+foo = Foo { a = 3 }+bar = Bar {+    abc = foo,+    def = Foo {a = 10}+}+baz = Baz{ }+sym = Foo { (+) = 3 }+aLongVariableName =+  ALongRecordName+    { short = baz,+      aLongRecordFieldName = YetAnotherLongRecordName+        { yetAnotherLongRecordFieldName = "a long string"+          },+      aLongRecordFieldName2 = Just YetAnotherLongRecordName+                                 { yetAnotherLongRecordFieldName = "a long string",+                                   yetAnotherLongRecordFieldName = Just+                                                                     "a long string"+                                   },+      aLongRecordFieldName3 = do+                               foo+                               bar+      }
+ data/examples/declaration/value/function/record-updaters-out.hs view
@@ -0,0 +1,11 @@+foo x = x {a = 3}++bar x =+  x+    { abc = foo,+      def = Foo {a = 10}+    }++baz x = x {}++sym x = x {(+) = 4}
+ data/examples/declaration/value/function/record-updaters.hs view
@@ -0,0 +1,7 @@+foo x = x { a = 3 }+bar x = x {+    abc = foo,+    def = Foo {a = 10}+}+baz x = x{ }+sym x = x { (+) = 4 }
+ data/examples/declaration/value/function/record-wildcards-out.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++foo x y = Foo {x, y}++bar x y z = Bar+  { x,+    y,+    z,+    ..+  }++baz = Baz {..}
+ data/examples/declaration/value/function/record-wildcards.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RecordWildCards #-}++foo x y = Foo { x, y }++bar x y z = Bar {+    x,+    y,+    z,+    ..+}++baz = Baz { .. }
+ 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,10 @@+{-# LANGUAGE TypeApplications #-}++foo = f @String a b c++bar = f @(Maybe Int) a b++baz =+  f @Int @String+    a+    b
+ data/examples/declaration/value/function/type-applications.hs view
@@ -0,0 +1,8 @@+{-# LANGUAGE TypeApplications #-}++foo = f @String a b c++bar = f @(Maybe Int) a b++baz = f @Int @String+  a b
+ 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-prelude-out.hs view
@@ -0,0 +1,4 @@+module P where++import Prelude hiding ((.), id)+import qualified Prelude
+ 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,22 @@+{-# 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/shebang-out.hs view
@@ -0,0 +1,5 @@+#! /usr/bin/env runhaskell+import Prelude++main :: IO ()+main = putStrLn "hello world"
+ data/examples/module-header/shebang.hs view
@@ -0,0 +1,5 @@+#! /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,5 @@+-- | 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/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,9 @@+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,3 @@+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-alignment-out.hs view
@@ -0,0 +1,10 @@+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-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-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/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/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-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,15 @@+{-# 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.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
+ ormolu.cabal view
@@ -0,0 +1,165 @@+name:                 ormolu+version:              0.0.1.0+cabal-version:        1.18+tested-with:          GHC==8.6.5+license:              BSD3+license-file:         LICENSE.md+maintainer:           Mark Karpov <mark.karpov@tweag.io>+homepage:             https://github.com/tweag/ormolu+bug-reports:          https://github.com/tweag/ormolu/issues+category:             Development, Formatting+synopsis:             A formatter for Haskell source code+build-type:           Simple+description:          A formatter for Haskell source code.+extra-doc-files:      CONTRIBUTING.md+                    , CHANGELOG.md+                    , DESIGN.md+                    , README.md+data-files:           data/examples/declaration/annotation/*.hs+                    , data/examples/declaration/class/*.hs+                    , data/examples/declaration/data/*.hs+                    , data/examples/declaration/data/gadt/*.hs+                    , data/examples/declaration/default/*.hs+                    , data/examples/declaration/deriving/*.hs+                    , data/examples/declaration/foreign/*.hs+                    , data/examples/declaration/instance/*.hs+                    , data/examples/declaration/rewrite-rule/*.hs+                    , data/examples/declaration/role-annotation/*.hs+                    , data/examples/declaration/signature/complete/*.hs+                    , data/examples/declaration/signature/fixity/*.hs+                    , data/examples/declaration/signature/inline/*.hs+                    , data/examples/declaration/signature/minimal/*.hs+                    , data/examples/declaration/signature/pattern/*.hs+                    , data/examples/declaration/signature/set-cost-centre/*.hs+                    , data/examples/declaration/signature/specialize/*.hs+                    , data/examples/declaration/signature/type/*.hs+                    , data/examples/declaration/splice/*.hs+                    , data/examples/declaration/type-families/closed-type-family/*.hs+                    , data/examples/declaration/type-families/data-family/*.hs+                    , data/examples/declaration/type-families/type-family/*.hs+                    , data/examples/declaration/type-synonyms/*.hs+                    , data/examples/declaration/type/*.hs+                    , data/examples/declaration/value/function/*.hs+                    , data/examples/declaration/value/function/arrow/*.hs+                    , data/examples/declaration/value/function/comprehension/*.hs+                    , data/examples/declaration/value/function/do/*.hs+                    , data/examples/declaration/value/function/infix/*.hs+                    , data/examples/declaration/value/function/pattern/*.hs+                    , data/examples/declaration/value/other/*.hs+                    , data/examples/declaration/value/pattern-synonyms/*.hs+                    , data/examples/declaration/warning/*.hs+                    , data/examples/import/*.hs+                    , data/examples/module-header/*.hs+                    , data/examples/other/*.hs++source-repository head+  type:               git+  location:           https://github.com/tweag/ormolu.git++flag dev+  description:        Turn on development settings.+  manual:             True+  default:            False++library+  hs-source-dirs:     src+  build-depends:      base           >= 4.12 && < 5.0+                    , bytestring     >= 0.2 && < 0.11+                    , containers     >= 0.5 && < 0.7+                    , dlist          >= 0.8 && < 0.9+                    , exceptions     >= 0.6 && < 0.11+                    , ghc            == 8.6.5+                    , ghc-boot-th    == 8.6.5+                    , ghc-paths      >= 0.1 && < 0.2+                    , mtl            >= 2.0 && < 3.0+                    , syb            >= 0.7 && < 0.8+                    , text           >= 0.2 && < 1.3+  exposed-modules:    Ormolu+                    , Ormolu.Config+                    , Ormolu.Diff+                    , Ormolu.Exception+                    , Ormolu.Imports+                    , Ormolu.Parser+                    , Ormolu.Parser.Anns+                    , Ormolu.Parser.CommentStream+                    , Ormolu.Parser.Pragma+                    , Ormolu.Parser.Result+                    , Ormolu.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.Utils+  if flag(dev)+    ghc-options:      -Wall -Werror -Wcompat+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wnoncanonical-monad-instances+                      -Wnoncanonical-monadfail-instances+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010++test-suite tests+  main-is:            Spec.hs+  hs-source-dirs:     tests+  type:               exitcode-stdio-1.0+  build-depends:      base           >= 4.12 && < 5.0+                    , containers     >= 0.5 && < 0.7+                    , filepath       >= 1.2 && < 1.5+                    , hspec          >= 2.0 && < 3.0+                    , ormolu+                    , path           >= 0.6 && < 0.7+                    , path-io        >= 1.4.2 && < 2.0+                    , text           >= 0.2 && < 1.3+  build-tools:        hspec-discover >= 2.0 && < 3.0+  other-modules:+                      Ormolu.Parser.PragmaSpec+                    , Ormolu.PrinterSpec++  if flag(dev)+    ghc-options:      -Wall -Werror+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010++executable ormolu+  main-is:            Main.hs+  hs-source-dirs:     app+  build-depends:      base           >= 4.12 && < 5.0+                    , ghc            == 8.6.5+                    , gitrev         >= 1.3 && < 1.4+                    , optparse-applicative >= 0.14 && < 0.15+                    , ormolu+                    , text           >= 0.2 && < 1.3+  other-modules:      Paths_ormolu+  if flag(dev)+    ghc-options:      -Wall -Werror -Wcompat+                      -Wincomplete-record-updates+                      -Wincomplete-uni-patterns+                      -Wnoncanonical-monad-instances+                      -Wnoncanonical-monadfail-instances+  else+    ghc-options:      -O2 -Wall+  default-language:   Haskell2010
+ src/Ormolu.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE RecordWildCards #-}++-- | A formatter for Haskell source code.+module Ormolu+  ( ormolu,+    ormoluFile,+    ormoluStdin,+    Config (..),+    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+import System.IO (hGetContents, stdin)++-- | 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 ->+  -- | Location of source file+  FilePath ->+  -- | Input to format+  String ->+  m Text+ormolu cfg path str = do+  (ws, result0) <-+    parseModule' cfg OrmoluParsingFailed path str+  when (cfgDebug cfg) $ do+    traceM "warnings:\n"+    traceM (concatMap showWarn ws)+    traceM (prettyPrintParseResult result0)+  -- NOTE We're forcing 'txt' here because otherwise errors (such as+  -- messages about not-yet-supported functionality) will be thrown later+  -- when we try to parse the rendered code back, inside of GHC monad+  -- wrapper which will lead to error messages presenting the exceptions as+  -- GHC bugs.+  let !txt = printModule result0+  when (not (cfgUnsafe cfg) || cfgCheckIdempotency 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 (cfgCheckIdempotency 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 ->+  -- | 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 ->+  -- | Resulting rendition+  m Text+ormoluStdin cfg =+  liftIO (hGetContents stdin) >>= ormolu cfg "<stdin>"++----------------------------------------------------------------------------+-- Helpers++-- | A wrapper around 'parseModule'.+parseModule' ::+  MonadIO m =>+  -- | Ormolu configuration+  Config ->+  -- | 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+  (ws, r) <- parseModule cfg path str+  case r of+    Left (spn, err) -> liftIO $ throwIO (mkException spn err)+    Right x -> return (ws, 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,53 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Configuration options used by the tool.+module Ormolu.Config+  ( Config (..),+    defaultConfig,+    DynOption (..),+    dynOptionToLocatedStr,+  )+where++import qualified SrcLoc as GHC++-- | Ormolu configuration.+data Config+  = 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,+        -- | Do not fail if CPP pragma is present (still doesn't handle CPP but+        -- useful for formatting of files that enable the extension without+        -- actually containing CPP macros)+        cfgTolerateCpp :: !Bool,+        -- | Checks if re-formatting the result is idempotent.+        cfgCheckIdempotency :: !Bool+      }+  deriving (Eq, Show)++-- | Default 'Config'.+defaultConfig :: Config+defaultConfig = Config+  { cfgDynOptions = [],+    cfgUnsafe = False,+    cfgDebug = False,+    cfgTolerateCpp = False,+    cfgCheckIdempotency = False+  }++-- | 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,151 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}++-- | Diffing GHC ASTs modulo span positions.+module Ormolu.Diff+  ( Diff (..),+    diffParseResult,+    diffText,+  )+where++import BasicTypes (SourceText)+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.Result+import Ormolu.Utils+import qualified SrcLoc as GHC++-- | 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 = ps0+    }+  ParseResult+    { prCommentStream = cstream1,+      prParsedSource = ps1+    } =+    matchIgnoringSrcSpans cstream0 cstream1+      <> matchIgnoringSrcSpans ps0 ps1++-- | 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+      -- NOTE 'ByteString' implement '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` hsModuleEq+                `extQ` sourceTextEq+                `extQ` hsDocStringEq+                `ext2Q` forLocated+            )+            x+            y+      | otherwise = Different []+    srcSpanEq :: SrcSpan -> GenericQ Diff+    srcSpanEq _ _ = Same+    hsModuleEq :: HsModule GhcPs -> GenericQ Diff+    hsModuleEq hs0 hs1' =+      case cast hs1' :: Maybe (HsModule GhcPs) of+        Nothing -> Different []+        Just hs1 ->+          matchIgnoringSrcSpans+            hs0 {hsmodImports = sortImports (hsmodImports hs0)}+            hs1 {hsmodImports = sortImports (hsmodImports hs1)}+    sourceTextEq :: SourceText -> GenericQ Diff+    sourceTextEq _ _ = Same+    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 (flip 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,94 @@+{-# LANGUAGE LambdaCase #-}++-- | 'OrmoluException' type and surrounding definitions.+module Ormolu.Exception+  ( OrmoluException (..),+    withPrettyOrmoluExceptions,+  )+where++import Control.Exception+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+  = -- | Ormolu does not work with source files that use CPP+    OrmoluCppEnabled FilePath+  | -- | 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+  deriving (Eq, Show)++instance Exception OrmoluException where+  displayException = \case+    OrmoluCppEnabled path ->+      unlines+        [ "CPP is not supported:",+          withIndent path+        ]+    OrmoluParsingFailed s e ->+      showParsingErr "Parsing of source code 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"++-- | 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`+          OrmoluCppEnabled _ -> 2+          OrmoluParsingFailed _ _ -> 3+          OrmoluOutputParsingFailed _ _ -> 4+          OrmoluASTDiffers _ _ -> 5+          OrmoluNonIdempotentOutput _ _ _ -> 6++----------------------------------------------------------------------------+-- 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,81 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RankNTypes #-}++-- | 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 HsExtension+import HsImpExp (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 decl =+      decl+        { ideclHiding = second (fmap sortLies) <$> ideclHiding decl+        }++-- | 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 NoExt x w xs fl ->+    IEThingWith NoExt 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 NoExt x -> unLoc x+  IEThingAbs NoExt x -> unLoc x+  IEThingAll NoExt x -> unLoc x+  IEThingWith NoExt x _ _ _ -> unLoc x+  IEModuleContents NoExt _ -> notImplemented "IEModuleContents"+  IEGroup NoExt _ _ -> notImplemented "IEGroup"+  IEDoc NoExt _ -> notImplemented "IEDoc"+  IEDocNamed NoExt _ -> notImplemented "IEDocNamed"+  XIE NoExt -> notImplemented "XIE"++-- | 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,201 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- | Parser for Haskell source code.+module Ormolu.Parser+  ( parseModule,+    manualExts,+  )+where++import qualified CmdLineParser as GHC+import Control.Exception+import Control.Monad+import Control.Monad.IO.Class+import Data.List ((\\), foldl', isPrefixOf)+import Data.Maybe (catMaybes)+import qualified DynFlags as GHC+import qualified FastString as GHC+import GHC hiding (IE, parseModule, parser)+import GHC.LanguageExtensions.Type (Extension (..))+import GHC.Paths (libdir)+import qualified HeaderInfo 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 qualified Outputable as GHC+import qualified Parser as GHC+import qualified SrcLoc as GHC+import qualified StringBuffer as GHC++-- | Parse a complete module from string.+parseModule ::+  MonadIO m =>+  -- | Ormolu configuration+  Config ->+  -- | File name (only for source location annotations)+  FilePath ->+  -- | Input for parser+  String ->+  m+    ( [GHC.Warn],+      Either (SrcSpan, String) ParseResult+    )+parseModule Config {..} path input' = liftIO $ do+  let (input, extraComments) = stripLinePragmas path input'+  (ws, dynFlags) <- ghcWrapper $ do+    dynFlags0 <- initDynFlagsPure path input+    (dynFlags1, _, ws) <-+      GHC.parseDynamicFilePragma+        dynFlags0+        (dynOptionToLocatedStr <$> cfgDynOptions)+    return (ws, GHC.setGeneralFlag' GHC.Opt_Haddock dynFlags1)+  -- NOTE It's better to throw this outside of 'ghcWrapper' because+  -- otherwise the exception will be wrapped as a GHC panic, which we don't+  -- want.+  when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $+    throwIO (OrmoluCppEnabled path)+  let r = case runParser GHC.parseModule dynFlags path input of+        GHC.PFailed _ ss m ->+          Left (ss, GHC.showSDoc dynFlags m)+        GHC.POk pstate pmod ->+          let (comments, exts) = mkCommentStream extraComments pstate+           in Right ParseResult+                { prParsedSource = pmod,+                  prAnns = mkAnns pstate,+                  prCommentStream = comments,+                  prExtensions = exts+                }+  return (ws, r)++-- | 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+  ]++----------------------------------------------------------------------------+-- Helpers (taken from ghc-exactprint)++-- | Requires GhcMonad constraint because there is no pure variant of+-- 'parseDynamicFilePragma'. Yet, in constrast to 'initDynFlags', it does+-- not (try to) read the file at filepath, but solely depends on the module+-- source in the input string.+--+-- Passes "-hide-all-packages" to the GHC API to prevent parsing of package+-- environment files. However this only works if there is no invocation of+-- 'setSessionDynFlags' before calling 'initDynFlagsPure'. See GHC tickets+-- #15513, #15541.+initDynFlagsPure ::+  GHC.GhcMonad m =>+  -- | Module path+  FilePath ->+  -- | Module contents+  String ->+  -- | Dynamic flags for that module+  m GHC.DynFlags+initDynFlagsPure fp input = do+  -- I was told we could get away with using the 'unsafeGlobalDynFlags'. as+  -- long as 'parseDynamicFilePragma' is impure there seems to be no reason+  -- to use it.+  dflags0 <- setDefaultExts <$> GHC.getSessionDynFlags+  let tokens = GHC.getOptions dflags0 (GHC.stringToStringBuffer input) fp+  (dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 tokens+  -- Turn this on last to avoid T10942+  let dflags2 = dflags1 `GHC.gopt_set` GHC.Opt_KeepRawTokenStream+  -- Prevent parsing of .ghc.environment.* "package environment files"+  (dflags3, _, _) <-+    GHC.parseDynamicFlagsCmdLine+      dflags2+      [GHC.noLoc "-hide-all-packages"]+  _ <- GHC.setSessionDynFlags dflags3+  return dflags3++-- | Default runner of 'GHC.Ghc' action in 'IO'.+ghcWrapper :: GHC.Ghc a -> IO a+ghcWrapper act =+  let GHC.FlushOut flushOut = GHC.defaultFlushOut+   in GHC.runGhc (Just libdir) act+        `finally` flushOut++-- | 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++-- | Remove GHC style line pragams (@{-# LINE .. #-}@) and convert them into+-- comments.+stripLinePragmas :: FilePath -> String -> (String, [Located String])+stripLinePragmas path = unlines' . unzip . findLines path . lines+  where+    unlines' (a, b) = (unlines a, catMaybes b)++findLines :: FilePath -> [String] -> [(String, Maybe (Located String))]+findLines path = zipWith (checkLine path) [1 ..]++checkLine :: FilePath -> Int -> String -> (String, Maybe (Located String))+checkLine path line s+  | "{-# LINE" `isPrefixOf` s =+    let (pragma, res) = getPragma s+        size = length pragma+        ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1))+     in (res, Just $ L ss pragma)+  | "#!" `isPrefixOf` s =+    let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length s))+     in ("", Just $ L ss s)+  | otherwise = (s, Nothing)+  where+    mkSrcLoc' = mkSrcLoc (GHC.mkFastString path) line++getPragma :: String -> (String, String)+getPragma [] = error "Ormolu.Parser.getPragma: input must not be empty"+getPragma s@(x : xs)+  | "#-}" `isPrefixOf` s = ("#-}", "   " ++ drop 3 s)+  | otherwise =+    let (prag, remline) = getPragma xs+     in (x : prag, ' ' : remline)++-- | Enable all language extensions that we think should be enabled by+-- default for ease of use.+setDefaultExts :: DynFlags -> DynFlags+setDefaultExts flags = foldl' GHC.xopt_set flags autoExts+  where+    autoExts = allExts \\ manualExts+    allExts = [minBound .. maxBound]++deriving instance Bounded Extension
+ 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,138 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TupleSections #-}++-- | Functions for working with comment stream.+module Ormolu.Parser.CommentStream+  ( CommentStream (..),+    Comment (..),+    mkCommentStream,+    isPrevHaddock,+    isMultilineComment,+    showCommentStream,+  )+where++import Data.Char (isSpace)+import Data.Data (Data)+import Data.Either (partitionEithers)+import Data.List (dropWhileEnd, isPrefixOf, sortOn)+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.Utils (showOutputable)+import SrcLoc++-- | A stream of 'RealLocated' 'Comment's in ascending order with respect to+-- beginning of corresponding spans.+newtype CommentStream = CommentStream [RealLocated Comment]+  deriving (Eq, Data, Semigroup, Monoid)++-- | A wrapper for a single comment. The 'NonEmpty' list inside contains+-- lines of multiline comment @{- … -}@ or just single item\/line otherwise.+newtype Comment = Comment (NonEmpty String)+  deriving (Eq, Show, Data)++-- | Create 'CommentStream' from 'GHC.PState'. We also create a 'Set' of+-- extensions here, which is not sorted in any way. The pragma comment are+-- removed from the 'CommentStream'.+mkCommentStream ::+  -- | Extra comments to include+  [Located String] ->+  -- | Parser state to use for comment extraction+  GHC.PState ->+  -- | Comment stream and a set of extracted pragmas+  (CommentStream, [Pragma])+mkCommentStream extraComments pstate =+  ( CommentStream $+      -- NOTE It's easier to normalize pragmas right when we construct comment+      -- streams. Because this way we need to do it only once and when we+      -- perform checking later they'll automatically match.+      mkComment <$> sortOn (realSrcSpanStart . getLoc) comments,+    pragmas+  )+  where+    (comments, pragmas) = partitionEithers (partitionComments <$> rawComments)+    rawComments =+      mapMaybe toRealSpan $+        extraComments+          ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate)+          ++ concatMap+            (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd)+            (GHC.annotations_comments pstate)++-- | Test whether a 'Comment' looks like a Haddock following a definition,+-- i.e. something starting with @-- ^@.+isPrevHaddock :: Comment -> Bool+isPrevHaddock (Comment (x :| _)) = "-- ^" `isPrefixOf` x++-- | Is this comment multiline-style?+isMultilineComment :: Comment -> Bool+isMultilineComment (Comment (x :| _)) = "{-" `isPrefixOf` x++-- | Pretty-print a 'CommentStream'.+showCommentStream :: CommentStream -> String+showCommentStream (CommentStream xs) =+  unlines $+    showComment <$> xs+  where+    showComment (GHC.L l str) = showOutputable l ++ " " ++ show str++----------------------------------------------------------------------------+-- Helpers++-- | Normalize comment string. Sometimes one multi-line comment is turned+-- into several lines for subsequent outputting with correct indentation for+-- each line.+mkComment :: RealLocated String -> RealLocated Comment+mkComment (L l s) =+  L l . Comment . fmap dropTrailing $+    if "{-" `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 :| []+  where+    dropTrailing = dropWhileEnd isSpace+    startIndent = srcSpanStartCol l - 1++-- | 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++-- | If a given comment is a pragma, return it in parsed form in 'Right'.+-- Otherwise return the original comment unchanged.+partitionComments ::+  RealLocated String ->+  Either (RealLocated String) Pragma+partitionComments input =+  case parsePragma (unLoc input) of+    Nothing -> Left input+    Just pragma -> Right pragma
+ src/Ormolu/Parser/Pragma.hs view
@@ -0,0 +1,86 @@+{-# 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 Data.List+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 <- stripPrefix "{-#" input+  guard ("#-}" `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 = 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.ParserFlags+      { L.pWarningFlags = ES.empty,+        L.pExtensionFlags = ES.empty,+        L.pThisPackage = newSimpleUnitId (ComponentId (mkFastString "")),+        L.pExtsBitmap = 0xffffffffffffffff+      }++-- | 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,36 @@+{-# LANGUAGE RecordWildCards #-}++-- | A type for result of parsing.+module Ormolu.Parser.Result+  ( ParseResult (..),+    prettyPrintParseResult,+  )+where++import GHC+import Ormolu.Parser.Anns+import Ormolu.Parser.CommentStream+import Ormolu.Parser.Pragma (Pragma)++-- | A collection of data that represents a parsed module in Ormolu.+data ParseResult+  = ParseResult+      { -- | 'ParsedSource' from GHC+        prParsedSource :: ParsedSource,+        -- | Ormolu-specfic representation of annotations+        prAnns :: Anns,+        -- | Comment stream+        prCommentStream :: CommentStream,+        -- | Extensions enabled in that module+        prExtensions :: [Pragma]+      }++-- | Pretty-print a 'ParseResult'.+prettyPrintParseResult :: ParseResult -> String+prettyPrintParseResult ParseResult {..} =+  unlines+    [ "parse result:",+      "  comment stream:",+      showCommentStream prCommentStream+      -- XXX extend as needed+    ]
+ src/Ormolu/Printer.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# 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++-- | Render a module.+printModule ::+  -- | Result of parsing+  ParseResult ->+  -- | Resulting rendition+  Text+printModule ParseResult {..} =+  runR+    (p_hsModule prExtensions prParsedSource)+    (mkSpanStream prParsedSource)+    prCommentStream+    prAnns
+ src/Ormolu/Printer/Combinators.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | 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,++    -- ** Comments+    HaddockStyle (..),+    setLastCommentSpan,+    getLastCommentSpan,+  )+where++import Control.Monad+import Data.Data (Data)+import Data.List (intersperse)+import Data.Text (Text)+import Ormolu.Printer.Comments+import Ormolu.Printer.Internal+import Ormolu.Utils (isModule)+import SrcLoc++----------------------------------------------------------------------------+-- 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 ::+  Data a =>+  -- | Thing to enter+  Located a ->+  -- | How to render inner value+  (a -> R ()) ->+  R ()+located loc f = do+  let withRealLocated (L l a) g =+        case l of+          UnhelpfulSpan _ -> return ()+          RealSrcSpan l' -> g (L l' a)+  withRealLocated loc spitPrecedingComments+  let setEnclosingSpan =+        case getLoc loc of+          UnhelpfulSpan _ -> id+          RealSrcSpan orf ->+            if isModule (unLoc loc)+              then id+              else withEnclosingSpan orf+  setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))+  withRealLocated loc spitFollowingComments++-- | A version of 'located' with arguments flipped.+located' ::+  Data a =>+  -- | 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 ","
+ src/Ormolu/Printer/Comments.hs view
@@ -0,0 +1,295 @@+{-# 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,+  )+where++import Control.Monad+import Data.Coerce (coerce)+import Data.Data (Data)+import qualified Data.List.NonEmpty as NE+import qualified Data.Text as T+import Ormolu.Parser.CommentStream+import Ormolu.Printer.Internal+import Ormolu.Utils (isModule)+import SrcLoc++----------------------------------------------------------------------------+-- Top-level++-- | Output all preceding comments for an element at given location.+spitPrecedingComments ::+  Data a =>+  -- | AST element to attach comments to+  RealLocated a ->+  R ()+spitPrecedingComments ref = do+  r <- getLastCommentSpan+  case r of+    Just (Just Pipe, _) ->+      -- We should not insert comments between pipe Haddock and the thing+      -- it's attached to.+      return ()+    _ -> do+      gotSome <- handleCommentSeries (spitPrecedingComment ref)+      when gotSome $ do+        -- Insert a blank line between the preceding comments and the thing+        -- after them if there was a blank line in the input.+        lastSpn <- fmap snd <$> getLastCommentSpan+        when (needsNewlineBefore (getLoc ref) lastSpn) newline++-- | Output all comments following an element at given location.+spitFollowingComments ::+  Data a =>+  -- | AST element of attach comments to+  RealLocated a ->+  R ()+spitFollowingComments ref = do+  trimSpanStream (getLoc ref)+  void $ handleCommentSeries (spitFollowingComment ref)++-- | Output all remaining comments in the comment stream.+spitRemainingComments :: R ()+spitRemainingComments = void $ handleCommentSeries spitRemainingComment++----------------------------------------------------------------------------+-- Single-comment functions++-- | Output a single preceding comment for an element at given location.+spitPrecedingComment ::+  Data a =>+  -- | AST element to attach comments to+  RealLocated a ->+  -- | Location of last comment in the series+  Maybe RealSrcSpan ->+  -- | Are we done?+  R Bool+spitPrecedingComment (L ref a) mlastSpn = do+  let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref+  withPoppedComment p $ \l comment -> do+    dirtyLine <-+      case mlastSpn of+        -- NOTE When the current line is dirty it means that something that+        -- can have comments attached to it is already on the line. To avoid+        -- problems with idempotence we cannot output the first comment+        -- immediately because it'll be attached to the previous element (on+        -- the same line) on the next run, so we play safe here and output+        -- an extra 'newline' in this case.+        Nothing -> isLineDirty -- only for very first preceding comment+        Just _ -> return False+    when (dirtyLine || needsNewlineBefore l mlastSpn) newline+    spitCommentNow l comment+    if theSameLinePre l ref && not (isModule a)+      then space+      else newline++-- | Output a comment that follows element at given location immediately on+-- the same line, if there is any.+spitFollowingComment ::+  Data a =>+  -- | AST element to attach comments to+  RealLocated a ->+  -- | Location of last comment in the series+  Maybe RealSrcSpan ->+  -- | Are we done?+  R Bool+spitFollowingComment (L ref a) mlastSpn = do+  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 mlastSpn) $ \l comment ->+    if theSameLinePost l ref && not (isModule a)+      then+        if isMultilineComment comment+          then space >> spitCommentNow l comment+          else spitCommentPending OnTheSameLine l comment+      else do+        when (needsNewlineBefore l mlastSpn) $+          registerPendingCommentLine OnNextLine ""+        spitCommentPending OnNextLine l comment++-- | Output a single remaining comment from the comment stream.+spitRemainingComment ::+  -- | Location of last comment in the series+  Maybe RealSrcSpan ->+  -- | Are we done?+  R Bool+spitRemainingComment mlastSpn =+  withPoppedComment (const True) $ \l comment -> do+    when (needsNewlineBefore l mlastSpn) 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+  (Maybe RealSrcSpan -> R Bool) ->+  -- | Whether we printed any comments+  R Bool+handleCommentSeries f = go False+  where+    go gotSome = do+      done <- getLastCommentSpan >>= f . fmap snd+      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 RealSrcSpan ->+  Bool+needsNewlineBefore l mlastSpn =+  case mlastSpn of+    Nothing -> False+    Just lastSpn ->+      srcSpanStartLine l > srcSpanEndLine lastSpn + 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 RealSrcSpan ->+  -- | Comment to test+  RealLocated Comment ->+  Bool+commentFollowsElt ref mnSpn meSpn mlastSpn (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+        || isPrevHaddock comment -- b) it's a Haddock string starting with -- ^+        || continuation -- c) it's a continuation of a comment block+        || lastInEnclosing -- d) it's the last element in the enclosing construct++    -- 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 if startColumn espn > startColumn ref+                then True+                else+                  abs (startColumn espn - startColumn l)+                    >= abs (startColumn ref - startColumn l)+    continuation =+      case mlastSpn of+        Nothing -> False+        Just spn -> srcSpanEndLine spn + 1 == srcSpanStartLine l+    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)+    . coerce+    $ comment+  setLastCommentSpan Nothing 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)+    . coerce+    $ comment+  setLastCommentSpan Nothing spn
+ src/Ormolu/Printer/Internal.hs view
@@ -0,0 +1,514 @@+{-# 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,+    atom,+    space,+    newline,+    isLineDirty,+    inci,+    sitcc,+    Layout (..),+    enterLayout,+    vlayout,+    getLayout,++    -- * Helpers for braces+    useBraces,+    dontUseBraces,+    canUseBraces,++    -- * Special helpers for comment placement+    CommentPosition (..),+    registerPendingCommentLine,+    trimSpanStream,+    nextEltSpan,+    popComment,+    getEnclosingSpan,+    withEnclosingSpan,+    HaddockStyle (..),+    setLastCommentSpan,+    getLastCommentSpan,++    -- * 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)+import SrcLoc++----------------------------------------------------------------------------+-- 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,+        -- | If the last expression in the layout can use braces+        rcCanUseBraces :: Bool+      }++-- | State context of 'R'.+data SC+  = SC+      { -- | Index of the next column to render+        scColumn :: !Int,+        -- | Rendered source code so far+        scBuilder :: Builder,+        -- | Span stream+        scSpanStream :: SpanStream,+        -- | Comment stream+        scCommentStream :: CommentStream,+        -- | Pending comment lines (in reverse order) to be inserted before next+        -- newline, 'Int' is the indentation level+        scPendingComments :: ![(CommentPosition, Int, Text)],+        -- | Whether the current line is “dirty”, that is, already contains+        -- atoms that can have comments attached to them+        scDirtyLine :: !Bool,+        -- | Whether to output a space before the next output+        scRequestedDelimiter :: !RequestedDelimiter,+        -- | Span of last output comment+        scLastCommentSpan :: !(Maybe (Maybe HaddockStyle, RealSrcSpan))+      }++-- | 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 ->+  -- | Resulting rendition+  Text+runR (R m) sstream cstream anns =+  TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc+  where+    rc = RC+      { rcIndent = 0,+        rcLayout = MultiLine,+        rcEnclosingSpans = [],+        rcAnns = anns,+        rcCanUseBraces = False+      }+    sc = SC+      { scColumn = 0,+        scBuilder = mempty,+        scSpanStream = sstream,+        scCommentStream = cstream,+        scPendingComments = [],+        scDirtyLine = False,+        scRequestedDelimiter = VeryBeginning,+        scLastCommentSpan = Nothing+      }++----------------------------------------------------------------------------+-- Internal functions++-- | 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 False False++-- | 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 True False . T.pack . showOutputable++-- | Low-level non-public helper to define 'txt' and 'atom'.+spit ::+  -- | Should we mark the line as dirty?+  Bool ->+  -- | Used during outputting of pending comments?+  Bool ->+  -- | 'Text' to output+  Text ->+  R ()+spit dirty printingComments txt' = do+  requestedDel <- R (gets scRequestedDelimiter)+  case requestedDel of+    RequestedNewline -> do+      R . modify $ \sc ->+        sc+          { scRequestedDelimiter = RequestedNothing+          }+      if printingComments+        then newlineRaw+        else newline+    _ -> return ()+  R $ do+    i <- asks rcIndent+    c <- gets scColumn+    let spaces =+          if c < i+            then T.replicate (i - c) " "+            else bool mempty " " (requestedDel == RequestedSpace)+        indentedTxt = spaces <> txt'+    modify $ \sc ->+      sc+        { scBuilder = scBuilder sc <> fromText indentedTxt,+          scColumn = scColumn sc + T.length indentedTxt,+          scDirtyLine = scDirtyLine sc || dirty,+          scRequestedDelimiter = RequestedNothing,+          scLastCommentSpan =+            -- NOTE If there are pending comments, do not reset last comment+            -- location.+            if printingComments || (not . null . scPendingComments) sc+              then scLastCommentSpan 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+  cs <- reverse <$> R (gets scPendingComments)+  case cs of+    [] -> newlineRaw+    ((position, _, _) : _) -> do+      case position of+        OnTheSameLine -> space+        OnNextLine -> newlineRaw+      R . forM_ cs $ \(_, indent, txt') ->+        let modRC rc =+              rc+                { rcIndent = indent+                }+            R m = do+              unless (T.null txt') $+                spit False True txt'+              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,+          scDirtyLine = False,+          scRequestedDelimiter = case scRequestedDelimiter sc of+            AfterNewline -> RequestedNewline+            RequestedNewline -> RequestedNewline+            VeryBeginning -> VeryBeginning+            _ -> AfterNewline+        }++-- | Check if the current line is “dirty”, that is, there is something on it+-- that can have comments attached to it.+isLineDirty :: R Bool+isLineDirty = R (gets scDirtyLine)++-- | 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. Only works (and makes sense) when enclosing+-- layout is multi-line.+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)+          }+  vlayout (R m) . R $ do+    modify $ \sc ->+      sc+        { scRequestedDelimiter = case requestedDel of+            RequestedSpace -> RequestedNothing+            other -> other+        }+    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 txt' = R $ do+  i <- asks rcIndent+  modify $ \sc ->+    sc+      { scPendingComments = (position, i, txt') : 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+        }++-- | Haddock string style.+data HaddockStyle+  = -- | @-- |@+    Pipe+  | -- | @-- ^@+    Caret+  | -- | @-- *@+    Asterisk Int+  | -- | @-- $@+    Named String++-- | Set span of last output comment.+setLastCommentSpan ::+  -- | 'HaddockStyle' or 'Nothing' if it's a non-Haddock comment+  Maybe HaddockStyle ->+  -- | Location of last printed comment+  RealSrcSpan ->+  R ()+setLastCommentSpan mhStyle spn = R . modify $ \sc ->+  sc+    { scLastCommentSpan = Just (mhStyle, spn)+    }++-- | Get span of last output comment.+getLastCommentSpan :: R (Maybe (Maybe HaddockStyle, RealSrcSpan))+getLastCommentSpan = R (gets scLastCommentSpan)++----------------------------------------------------------------------------+-- 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 = 2
+ src/Ormolu/Printer/Meat/Common.hs view
@@ -0,0 +1,182 @@+{-# 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 Data.Maybe (isJust)+import qualified Data.Text as T+import GHC hiding (GhcPs, IE)+import Name (nameStableString)+import OccName (OccName (..))+import Ormolu.Printer.Combinators+import Ormolu.Utils+import RdrName (RdrName (..))++-- | 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 ->+            -- NOTE This is used when GHC generates code that will be fed+            -- into the renamer (e.g. from deriving clauses), but where we+            -- want to say that something comes from given module which is+            -- not specified in the source code, e.g. @Prelude.map@.+            --+            -- 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 -- NOTE I'm not sure this "stable string" is stable enough, but it looks+        -- like this is the most robust way to tell if we're looking at exactly+        -- this piece of built-in syntax.+        ("$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+  goesAfterComment <- isJust <$> getLastCommentSpan+  -- 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 "-- |" >> space+        Caret -> txt "-- ^" >> space+        Asterisk n -> txt ("-- " <> T.replicate n "*") >> space+        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_ (setLastCommentSpan (Just hstyle))+    RealSrcSpan spn -> setLastCommentSpan (Just 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,262 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-}++-- | Rendering of declarations.+module Ormolu.Printer.Meat.Declaration+  ( p_hsDecls,+    hasSeparatedDecls,+  )+where++import Data.List (sort)+import Data.List.NonEmpty ((<|), NonEmpty (..))+import qualified Data.List.NonEmpty as NE+import GHC+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+import RdrName (rdrNameOcc)++p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()+p_hsDecls style decls = sepSemi id $+  -- Return a list of rendered declarations, adding a newline to separate+  -- groups.+  case groupDecls decls of+    [] -> []+    (x : xs) ->+      NE.toList (renderGroup x)+        ++ concatMap (NE.toList . separateGroup . renderGroup) xs+  where+    renderGroup = fmap (located' $ dontUseBraces . p_hsDecl style)+    separateGroup (x :| xs) = (breakpoint' >> x) :| xs++-- | Group relevant declarations together.+--+-- Add a declaration to a group iff it is relevant to either the first or+-- the last declaration of 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 (lhdr : xs) =+  let -- Pick the first decl as the group header+      hdr = unLoc lhdr+      -- Zip rest of the decls with their previous decl+      zipped = zip (lhdr : xs) xs+      -- Pick decls from the tail if they are relevant to the group header+      -- or the previous decl.+      (grp, rest) = flip span zipped $ \(L _ prev, L _ cur) ->+        let relevantToHdr = groupedDecls hdr cur+            relevantToPrev = groupedDecls prev cur+         in relevantToHdr || relevantToPrev+   in (lhdr :| map snd grp) : groupDecls (map snd rest)++p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R ()+p_hsDecl style = \case+  TyClD NoExt x -> p_tyClDecl style x+  ValD NoExt x -> p_valDecl x+  SigD NoExt x -> p_sigDecl x+  InstD NoExt x -> p_instDecl style x+  DerivD NoExt x -> p_derivDecl x+  DefD NoExt x -> p_defaultDecl x+  ForD NoExt x -> p_foreignDecl x+  WarningD NoExt x -> p_warnDecls x+  AnnD NoExt x -> p_annDecl x+  RuleD NoExt x -> p_ruleDecls x+  SpliceD NoExt x -> p_spliceDecl x+  DocD NoExt 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 NoExt x -> p_roleAnnot x+  XHsDecl _ -> notImplemented "XHsDecl"++p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R ()+p_tyClDecl style = \case+  FamDecl NoExt 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 {} -> notImplemented "XTyClDecl"++p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R ()+p_instDecl style = \case+  ClsInstD NoExt x -> p_clsInstDecl x+  TyFamInstD NoExt x -> p_tyFamInstDecl style x+  DataFamInstD NoExt x -> p_dataFamInstDecl style x+  XInstDecl _ -> notImplemented "XInstDecl"++p_derivDecl :: DerivDecl GhcPs -> R ()+p_derivDecl = \case+  d@DerivDecl {..} -> p_standaloneDerivDecl d+  XDerivDecl _ -> notImplemented "XDerivDecl standalone deriving"++-- | Determine if these declarations should be grouped together.+groupedDecls ::+  HsDecl GhcPs ->+  HsDecl GhcPs ->+  Bool+groupedDecls (TypeSignature ns) (FunctionBody ns') = ns `intersects` ns'+groupedDecls x (FunctionBody ns) | Just ns' <- isPragma x = ns `intersects` ns'+groupedDecls (FunctionBody ns) x | Just ns' <- isPragma x = ns `intersects` ns'+groupedDecls x (DataDeclaration n) | Just ns <- isPragma x = n `elem` ns+groupedDecls (DataDeclaration n) x+  | Just ns <- isPragma x =+    let f = occNameFS . rdrNameOcc in f n `elem` map f ns+groupedDecls x y | Just ns <- isPragma x, Just ns' <- isPragma y = ns `intersects` ns'+groupedDecls x (TypeSignature ns) | Just ns' <- isPragma x = ns `intersects` ns'+groupedDecls (TypeSignature ns) x | Just ns' <- isPragma x = ns `intersects` ns'+groupedDecls (PatternSignature ns) (Pattern n) = n `elem` ns+groupedDecls DocNext _ = True+groupedDecls _ DocPrev = True+groupedDecls _ _ = 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++-- | Checks if given list of declarations contain a pair which should+-- be separated by a blank line.+hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool+hasSeparatedDecls xs = case groupDecls xs of+  _ : _ : _ -> True+  _ -> False++isPragma ::+  HsDecl GhcPs ->+  Maybe [RdrName]+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 referring to a single name++pattern+  InlinePragma,+  SpecializePragma,+  SCCPragma,+  AnnTypePragma,+  AnnValuePragma,+  Pattern,+  DataDeclaration ::+    RdrName -> HsDecl GhcPs+pattern InlinePragma n <- SigD NoExt (InlineSig NoExt (L _ n) _)+pattern SpecializePragma n <- SigD NoExt (SpecSig NoExt (L _ n) _ _)+pattern SCCPragma n <- SigD NoExt (SCCFunSig NoExt _ (L _ n) _)+pattern AnnTypePragma n <- AnnD NoExt (HsAnnotation NoExt _ (TypeAnnProvenance (L _ n)) _)+pattern AnnValuePragma n <- AnnD NoExt (HsAnnotation NoExt _ (ValueAnnProvenance (L _ n)) _)+pattern Pattern n <- ValD NoExt (PatSynBind NoExt (PSB _ (L _ n) _ _ _))+pattern DataDeclaration n <- TyClD NoExt (DataDecl NoExt (L _ n) _ _ _)++-- Declarations which can refer to multiple names++pattern+  TypeSignature,+  FunctionBody,+  PatternSignature,+  WarningPragma ::+    [RdrName] -> HsDecl GhcPs+pattern TypeSignature n <- (sigRdrNames -> 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 NoExt (DocCommentNext _))+pattern DocPrev <- (DocD NoExt (DocCommentPrev _))++sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+sigRdrNames (SigD NoExt (TypeSig NoExt ns _)) = Just $ map unLoc ns+sigRdrNames (SigD NoExt (ClassOpSig NoExt _ ns _)) = Just $ map unLoc ns+sigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns+sigRdrNames _ = Nothing++funRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+funRdrNames (ValD NoExt (FunBind NoExt (L _ n) _ _ _)) = Just [n]+funRdrNames (ValD NoExt (PatBind NoExt (L _ n) _ _)) = Just $ patBindNames n+funRdrNames _ = Nothing++patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+patSigRdrNames (SigD NoExt (PatSynSig NoExt ns _)) = Just $ map unLoc ns+patSigRdrNames _ = Nothing++warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName]+warnSigRdrNames (WarningD NoExt (Warnings NoExt _ ws)) = Just $ flip concatMap ws $ \case+  L _ (Warning NoExt ns _) -> map unLoc ns+  L _ (XWarnDecl NoExt) -> []+warnSigRdrNames _ = Nothing++patBindNames :: Pat GhcPs -> [RdrName]+patBindNames (TuplePat NoExt ps _) = concatMap (patBindNames . unLoc) ps+patBindNames (VarPat NoExt (L _ n)) = [n]+patBindNames (WildPat NoExt) = []+patBindNames (LazyPat NoExt (L _ p)) = patBindNames p+patBindNames (BangPat NoExt (L _ p)) = patBindNames p+patBindNames (ParPat NoExt (L _ p)) = patBindNames p+patBindNames (ListPat NoExt ps) = concatMap (patBindNames . unLoc) ps+patBindNames (AsPat NoExt (L _ n) (L _ p)) = n : patBindNames p+patBindNames (SumPat NoExt (L _ p) _ _) = patBindNames p+patBindNames (ViewPat NoExt _ (L _ p)) = patBindNames p+patBindNames (SplicePat NoExt _) = []+patBindNames (LitPat NoExt _) = []+patBindNames (SigPat _ (L _ p)) = patBindNames p+patBindNames (NPat NoExt _ _ _) = []+patBindNames (NPlusKPat NoExt (L _ n) _ _ _ _) = [n]+patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d)+patBindNames (ConPatOut _ _ _ _ _ _ _) = notImplemented "ConPatOut" -- created by renamer+patBindNames (CoPat NoExt _ p _) = patBindNames p+patBindNames (XPat NoExt) = notImplemented "XPat"
+ src/Ormolu/Printer/Meat/Declaration.hs-boot view
@@ -0,0 +1,13 @@+module Ormolu.Printer.Meat.Declaration+  ( p_hsDecls,+    hasSeparatedDecls,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common++p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R ()++hasSeparatedDecls :: [LHsDecl GhcPs] -> Bool
+ src/Ormolu/Printer/Meat/Declaration/Annotation.hs view
@@ -0,0 +1,27 @@+{-# 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+import Ormolu.Utils++p_annDecl :: AnnDecl GhcPs -> R ()+p_annDecl = \case+  HsAnnotation NoExt _ annProv expr -> pragma "ANN" . inci $ do+    p_annProv annProv+    breakpoint+    located expr p_hsExpr+  XAnnDecl {} -> notImplemented "XAnnDecl"++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,113 @@+{-# 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 (sortBy)+import Data.Ord (comparing)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration+import Ormolu.Printer.Meat.Type+import Ormolu.Utils+import RdrName (RdrName (..))++p_classDecl ::+  LHsContext GhcPs ->+  Located RdrName ->+  LHsQTyVars GhcPs ->+  LexicalFixity ->+  [Located (FunDep (Located RdrName))] ->+  [LSig GhcPs] ->+  LHsBinds GhcPs ->+  [LFamilyDecl GhcPs] ->+  [LTyFamDefltEqn GhcPs] ->+  [LDocDecl] ->+  R ()+p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs cdocs = do+  let HsQTvs {..} = tvars+      variableSpans = getLoc <$> hsq_explicit+      signatureSpans = getLoc name : variableSpans+      dependencySpans = getLoc <$> fdeps+      combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)+  txt "class"+  switchLayout combinedSpans $ do+    breakpoint+    inci $ do+      p_classContext ctx+      switchLayout signatureSpans $ do+        p_infixDefHelper+          (isInfix fixity)+          inci+          (p_rdrName name)+          (located' p_hsTyVarBndr <$> hsq_explicit)+      inci (p_classFundeps fdeps)+  -- NOTE GHC's AST does not necessarily store each kind of element in+  -- source location order. This happens because different declarations are+  -- stored in different lists. Consequently, to get all the declarations in+  -- proper order, they need to be manually sorted.+  let sigs = (getLoc &&& fmap (SigD NoExt)) <$> csigs+      vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cdefs+      tyFams = (getLoc &&& fmap (TyClD NoExt . FamDecl NoExt)) <$> cats+      docs = (getLoc &&& fmap (DocD NoExt)) <$> cdocs+      tyFamDefs =+        ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt . defltEqnToInstDecl)+        )+          <$> catdefs+      allDecls =+        snd <$> sortBy (comparing fst) (sigs <> vals <> tyFams <> tyFamDefs <> docs)+  unless (null allDecls) $ do+    space+    txt "where"+    breakpoint -- Ensure whitespace is added after where clause.+    -- Add newline before first declaration if the body contains separate+    -- declarations.+    when (hasSeparatedDecls allDecls) breakpoint'+    inci (p_hsDecls Associated allDecls)++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++defltEqnToInstDecl :: TyFamDefltEqn GhcPs -> TyFamInstDecl GhcPs+defltEqnToInstDecl FamEqn {..} = TyFamInstDecl {..}+  where+    eqn = FamEqn {feqn_pats = tyVarsToTypes feqn_pats, ..}+    tfid_eqn = HsIB {hsib_ext = NoExt, hsib_body = eqn}+defltEqnToInstDecl XFamEqn {} = notImplemented "XFamEqn"++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False
+ src/Ormolu/Printer/Meat/Declaration/Data.hs view
@@ -0,0 +1,245 @@+{-# 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)+import Data.Maybe (maybeToList)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type+import Ormolu.Utils+import RdrName (RdrName (..))+import SrcLoc (Located)++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"+  switchLayout (getLoc name : fmap getLoc tpats) $ 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 do+        space+        txt "where"+        breakpoint+        inci $ sepSemi (located' p_conDecl) dd_cons+      else switchLayout (getLoc name : (getLoc <$> dd_cons))+        $ inci+        $ do+          breakpoint+          txt "="+          space+          let s =+                vlayout+                  (space >> txt "|" >> space)+                  (newline >> txt "|" >> space)+          sep s (sitcc . located' p_conDecl) dd_cons+  unless (null $ unLoc dd_derivs) breakpoint+  inci . located dd_derivs $ \xs -> do+    sep newline (located' p_hsDerivingClause) xs+p_dataDecl _ _ _ _ (XHsDataDefn NoExt) = notImplemented "XHsDataDefn"++p_conDecl :: ConDecl GhcPs -> R ()+p_conDecl = \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+        p_forallBndrs (hsq_explicit con_qvars)+        unless (null $ 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 conDeclSpn =+          [getLoc con_name]+            <> fmap getLoc con_ex_tvs+            <> maybeToList (fmap getLoc con_mb_cxt)+            <> conArgsSpans con_args+    switchLayout conDeclSpn $ do+      p_forallBndrs con_ex_tvs+      unless (null con_ex_tvs) breakpoint+      forM_ con_mb_cxt p_lhsContext+      case con_args of+        PrefixCon xs -> do+          p_rdrName con_name+          unless (null xs) breakpoint+          inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs+        RecCon l -> do+          p_rdrName con_name+          breakpoint+          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 NoExt -> notImplemented "XConDecl"++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 NoExt -> []++p_forallBndrs ::+  [LHsTyVarBndr GhcPs] ->+  R ()+p_forallBndrs = \case+  [] -> return ()+  bndrs -> do+    txt "forall"+    space+    sep space (located' p_hsTyVarBndr) bndrs+    txt "."++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 NoExt) ->+        notImplemented "XHsImplicitBndrs"+p_hsDerivingClause (XHsDerivingClause NoExt) = notImplemented "XHsDerivingClause"++----------------------------------------------------------------------------+-- Helpers++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False
+ src/Ormolu/Printer/Meat/Declaration/Default.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++module Ormolu.Printer.Meat.Declaration.Default+  ( p_defaultDecl,+  )+where++import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Type+import Ormolu.Utils++p_defaultDecl :: DefaultDecl GhcPs -> R ()+p_defaultDecl = \case+  DefaultDecl NoExt ts -> do+    txt "default"+    breakpoint+    inci . parens N . sitcc $+      sep (comma >> breakpoint) (sitcc . located' p_hsType) ts+  XDefaultDecl {} -> notImplemented "XDefaultDecl"
+ src/Ormolu/Printer/Meat/Declaration/Foreign.hs view
@@ -0,0 +1,72 @@+{-# 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+import Ormolu.Utils++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 {} -> notImplemented "XForeignDecl"++-- | 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+  -- Switch into the layout of the signature, to allow us to pull name and+  -- signature onto a single line.+  inci . switchLayout [getLoc . hsib_body $ fd_sig_ty fd] $ do+    p_rdrName (fd_name fd)+    p_typeAscription (HsWC NoExt (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,137 @@+{-# 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 (sortBy)+import Data.Ord (comparing)+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 -> do+      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 NoExt) ->+        notImplemented "XHsImplicitBndrs"+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 NoExt)) <$> cid_sigs+            vals = (getLoc &&& fmap (ValD NoExt)) <$> toList cid_binds+            tyFamInsts =+              ( getLoc &&& fmap (InstD NoExt . TyFamInstD NoExt)+              )+                <$> cid_tyfam_insts+            dataFamInsts =+              ( getLoc &&& fmap (InstD NoExt . DataFamInstD NoExt)+              )+                <$> cid_datafam_insts+            allDecls =+              snd+                <$> sortBy (comparing 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) $ do+          inci $ do+            -- Ensure whitespace is added after where clause.+            breakpoint+            -- Add newline before first declaration if the body contains separate+            -- declarations+            when (hasSeparatedDecls allDecls) breakpoint'+            dontUseBraces $ p_hsDecls Associated allDecls+      XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"+  XClsInstDecl NoExt -> notImplemented "XClsInstDecl"++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 {..} -> do+    let HsIB {..} = dfid_eqn+        FamEqn {..} = hsib_body+    p_dataDecl style feqn_tycon feqn_pats feqn_fixity feqn_rhs++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,39 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# 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+import Ormolu.Utils+import RdrName (RdrName (..))+import SrcLoc (Located)++p_roleAnnot :: RoleAnnotDecl GhcPs -> R ()+p_roleAnnot = \case+  RoleAnnotDecl NoExt l_name anns -> p_roleAnnot' l_name anns+  XRoleAnnotDecl _ -> notImplemented "XRoleAnnotDecl"++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,62 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Ormolu.Printer.Meat.Declaration.Rule+  ( p_ruleDecls,+  )+where++import BasicTypes+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.Utils++p_ruleDecls :: RuleDecls GhcPs -> R ()+p_ruleDecls = \case+  HsRules NoExt _ xs ->+    pragma "RULES" . sitcc $+      sep breakpoint (sitcc . located' p_ruleDecl) xs+  XRuleDecls NoExt -> notImplemented "XRuleDecls"++p_ruleDecl :: RuleDecl GhcPs -> R ()+p_ruleDecl = \case+  HsRule NoExt ruleName activation ruleBndrs lhs rhs -> do+    located ruleName p_ruleName+    space+    p_activation activation+    space+    p_ruleBndrs ruleBndrs+    breakpoint+    inci $ do+      located lhs p_hsExpr+      space+      txt "="+      inci $ do+        breakpoint+        located rhs p_hsExpr+  XRuleDecl NoExt -> notImplemented "XRuleDecl"++p_ruleName :: (SourceText, RuleName) -> R ()+p_ruleName (_, name) = atom $ HsString NoSourceText name++p_ruleBndrs :: [LRuleBndr GhcPs] -> R ()+p_ruleBndrs [] = return ()+p_ruleBndrs bndrs =+  switchLayout (getLoc <$> bndrs) $ do+    txt "forall"+    breakpoint+    inci $ do+      sitcc $ sep breakpoint (sitcc . located' p_ruleBndr) bndrs+      txt "."++p_ruleBndr :: RuleBndr GhcPs -> R ()+p_ruleBndr = \case+  RuleBndr NoExt x -> p_rdrName x+  RuleBndrSig NoExt x hswc -> parens N $ do+    p_rdrName x+    p_typeAscription hswc+  XRuleBndr NoExt -> notImplemented "XRuleBndr"
+ src/Ormolu/Printer/Meat/Declaration/Signature.hs view
@@ -0,0 +1,220 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Type signature declarations.+module Ormolu.Printer.Meat.Declaration.Signature+  ( p_sigDecl,+    p_typeAscription,+    p_activation,+  )+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 NoExt names hswc -> p_typeSig True names hswc+  PatSynSig NoExt names hsib -> p_patSynSig names hsib+  ClassOpSig NoExt def names hsib -> p_classOpSig def names hsib+  FixSig NoExt sig -> p_fixSig sig+  InlineSig NoExt name inlinePragma -> p_inlineSig name inlinePragma+  SpecSig NoExt name ts inlinePragma -> p_specSig name ts inlinePragma+  SpecInstSig NoExt _ hsib -> p_specInstSig hsib+  MinimalSig NoExt _ booleanFormula -> p_minimalSig booleanFormula+  CompleteMatchSig NoExt _sourceText cs ty -> p_completeSig cs ty+  SCCFunSig NoExt _ 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 bool id inci indentTail $ do+      comma+      breakpoint+      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 NoExt) = notImplemented "XHsWildCardBndrs"++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 = NoExt, 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 = NoExt, hswc_body = hsib}++p_fixSig ::+  FixitySig GhcPs ->+  R ()+p_fixSig = \case+  FixitySig NoExt 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 NoExt -> notImplemented "XFixitySig"++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
+ src/Ormolu/Printer/Meat/Declaration/Splice.hs view
@@ -0,0 +1,16 @@+{-# 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)+import Ormolu.Utils++p_spliceDecl :: SpliceDecl GhcPs -> R ()+p_spliceDecl = \case+  SpliceDecl NoExt splice _explicit -> located splice p_hsSplice+  XSpliceDecl {} -> notImplemented "XSpliceDecl"
+ 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+import RdrName (RdrName (..))+import SrcLoc (Located)++p_synDecl ::+  -- | Type constructor+  Located RdrName ->+  -- | Fixity+  LexicalFixity ->+  -- | Type variables+  LHsQTyVars GhcPs ->+  -- | RHS of type declaration+  LHsType GhcPs ->+  R ()+p_synDecl name fixity tvars t = do+  txt "type"+  space+  let HsQTvs {..} = tvars+  switchLayout (getLoc name : map getLoc hsq_explicit) $ do+    p_infixDefHelper+      (case fixity of Infix -> True; _ -> False)+      inci+      (p_rdrName name)+      (map (located' p_hsTyVarBndr) hsq_explicit)+  space+  txt "="+  breakpoint+  inci (located t p_hsType)
+ src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of data\/type families.+module Ormolu.Printer.Meat.Declaration.TypeFamily+  ( p_famDecl,+    p_tyFamInstEqn,+  )+where++import BasicTypes (LexicalFixity (..))+import Control.Monad+import Data.Maybe (isJust, isNothing)+import GHC+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Printer.Meat.Type+import Ormolu.Utils+import SrcLoc (GenLocated (..), Located)++p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R ()+p_famDecl style FamilyDecl {..} = 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"+  let HsQTvs {..} = fdTyVars+  breakpoint+  inci $ do+    switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $ do+      p_infixDefHelper+        (isInfix fdFixity)+        inci+        (p_rdrName fdLName)+        (located' p_hsTyVarBndr <$> hsq_explicit)+    let rsig = p_familyResultSigL (isJust fdInjectivityAnn) fdResultSig+    unless (isNothing rsig && isNothing fdInjectivityAnn) $+      space+    inci $ do+      sequence_ rsig+      when (isJust rsig && isJust fdInjectivityAnn) breakpoint+      forM_ fdInjectivityAnn (located' p_injectivityAnn)+  case mmeqs of+    Nothing -> return ()+    Just meqs -> do+      space+      txt "where"+      case meqs of+        Nothing -> do+          space+          txt ".."+        Just eqs -> do+          newline+          sep newline (located' (inci . p_tyFamInstEqn)) eqs+p_famDecl _ (XFamilyDecl NoExt) = notImplemented "XFamilyDecl"++p_familyResultSigL ::+  Bool ->+  Located (FamilyResultSig GhcPs) ->+  Maybe (R ())+p_familyResultSigL injAnn l =+  case l of+    L _ a -> case a of+      NoSig NoExt -> Nothing+      KindSig NoExt k -> Just $ do+        if injAnn then txt "=" else txt "::"+        breakpoint+        located k p_hsType+      TyVarSig NoExt bndr -> Just $ do+        if injAnn then txt "=" else txt "::"+        breakpoint+        located bndr p_hsTyVarBndr+      XFamilyResultSig NoExt ->+        notImplemented "XFamilyResultSig"++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 {..} = do+  let FamEqn {..} = hsib_body+  switchLayout (getLoc feqn_tycon : (getLoc <$> feqn_pats)) $+    p_infixDefHelper+      (isInfix feqn_fixity)+      inci+      (p_rdrName feqn_tycon)+      (located' p_hsType <$> feqn_pats)+  space+  txt "="+  breakpoint+  inci (located feqn_rhs p_hsType)+p_tyFamInstEqn (XHsImplicitBndrs NoExt) = notImplemented "XHsImplicitBndrs"++----------------------------------------------------------------------------+-- Helpers++isInfix :: LexicalFixity -> Bool+isInfix = \case+  Infix -> True+  Prefix -> False
+ src/Ormolu/Printer/Meat/Declaration/Value.hs view
@@ -0,0 +1,1273 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++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.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.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+import RdrName (RdrName (..))+import RdrName (rdrNameOcc)+import SrcLoc (combineSrcSpans, isOneLineSpan)++-- | 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 NoExt funId funMatches _ _ -> p_funBind funId funMatches+  PatBind NoExt 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 NoExt psb -> p_patSynBind psb+  XHsBindsLR NoExt -> notImplemented "XHsBindsLR"++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+  -- NOTE 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 _ = notImplemented "XMatch"+p_matchGroup' _ _ _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"++-- | 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 m_grhss = do+  -- NOTE Normally, since patterns may be placed in a multi-line layout, it+  -- is necessary to bump indentation for the pattern group so it's more+  -- 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 . srcSpanEnd . getLoc) name+          _ -> Nothing+        Just pats -> (Just . srcSpanEnd . getLoc . NE.last) pats+      isCase = \case+        Case -> True+        LambdaCase -> True+        _ -> False+  let GRHSs {..} = m_grhss+      hasGuards = withGuards grhssGRHSs+  unless (length grhssGRHSs > 1) $ do+    case style of+      Function _ | hasGuards -> return ()+      Function _ -> space >> txt "="+      PatternBind -> space >> txt "="+      s | isCase s && hasGuards -> return ()+      _ -> space >> txt "->"+  let grhssSpan =+        combineSrcSpans' $+          getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs+      patGrhssSpan =+        maybe+          grhssSpan+          (combineSrcSpans grhssSpan . srcLocSpan)+          endOfPats+      placement =+        case endOfPats of+          Nothing -> blockPlacement placer grhssGRHSs+          Just spn ->+            if isOneLineSpan+              (mkSrcSpan spn (srcSpanStart 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+    switchLayout [patGrhssSpan] $+      placeHanging placement p_body+    inci p_where++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 NoExt guards body) =+  case guards of+    [] -> p_body+    xs -> do+      txt "|"+      space+      sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)+      space+      txt $ case style of+        EqualSign -> "="+        RightArrow -> "->"+      placeHanging placement p_body+  where+    placement =+      case endOfGuards of+        Nothing -> placer (unLoc body)+        Just spn ->+          if isOneLineSpan (mkSrcSpan spn (srcSpanStart (getLoc body)))+            then placer (unLoc body)+            else Normal+    endOfGuards =+      case NE.nonEmpty guards of+        Nothing -> Nothing+        Just gs -> (Just . srcSpanEnd . getLoc . NE.last) gs+    p_body = located body render+p_grhs' _ _ _ (XGRHS NoExt) = notImplemented "XGRHS"++p_hsCmd :: HsCmd GhcPs -> R ()+p_hsCmd = \case+  HsCmdArrApp NoExt body input arrType _ -> do+    located body p_hsExpr+    space+    case arrType of+      HsFirstOrderApp -> txt "-<"+      HsHigherOrderApp -> txt "-<<"+    placeHanging (exprPlacement (unLoc input)) $+      located input p_hsExpr+  HsCmdArrForm NoExt form Prefix _ cmds -> banana $ sitcc $ do+    located form p_hsExpr+    unless (null cmds) $ do+      breakpoint+      inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds)))+  HsCmdArrForm NoExt form Infix _ [left, right] -> do+    located left p_hsCmdTop+    space+    located form p_hsExpr+    placeHanging (cmdTopPlacement (unLoc right)) $+      located right p_hsCmdTop+  HsCmdArrForm NoExt _ 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 NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup+  HsCmdPar NoExt c -> parens N (located c p_hsCmd)+  HsCmdCase NoExt e mgroup ->+    p_case cmdPlacement p_hsCmd e mgroup+  HsCmdIf NoExt _ if' then' else' ->+    p_if cmdPlacement p_hsCmd if' then' else'+  HsCmdLet NoExt localBinds c ->+    p_let p_hsCmd localBinds c+  HsCmdDo NoExt es -> do+    txt "do"+    newline+    inci . located es $+      sitcc . sep newline (located' (sitcc . p_stmt' cmdPlacement p_hsCmd))+  HsCmdWrap {} -> notImplemented "HsCmdWrap"+  XCmd {} -> notImplemented "XCmd"++p_hsCmdTop :: HsCmdTop GhcPs -> R ()+p_hsCmdTop = \case+  HsCmdTop NoExt cmd -> located cmd p_hsCmd+  XCmdTop {} -> notImplemented "XHsCmdTop"++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 NoExt body _ _ -> located body render+  BindStmt NoExt l f _ _ -> do+    located l p_pat+    space+    txt "<-"+    let placement =+          case f of+            L l' x ->+              if isOneLineSpan+                (mkSrcSpan (srcSpanEnd (getLoc l)) (srcSpanStart l'))+                then placer x+                else Normal+    switchLayout [getLoc l, getLoc f] $+      placeHanging placement (located f render)+  ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer+  BodyStmt NoExt body _ _ -> located body render+  LetStmt NoExt binds -> do+    txt "let"+    space+    sitcc $ located binds p_hsLocalBinds+  ParStmt {} ->+    -- NOTE 'ParStmt' should always be eliminated in 'gatherStmt' already,+    -- such that it never occurs in 'p_stmt''. Consequently, handling it+    -- here would be redundant.+    notImplemented "ParStmt"+  TransStmt {..} -> do+    -- NOTE 'TransStmt' only needs to account for render printing itself,+    -- since pretty printing of relevant statements (e.g., in 'trS_stmts')+    -- is handled through 'gatherStmt'.+    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 (located' (p_stmt' placer render)) recS_stmts+  XStmtLR {} -> notImplemented "XStmtLR"++gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]+gatherStmt (L _ (ParStmt NoExt 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 {} = notImplemented "XParStmtBlock"++p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R ()+p_hsLocalBinds = \case+  HsValBinds NoExt (ValBinds NoExt 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+        -- Assigns 'False' to the last element, 'True' to the rest.+        markInit :: [a] -> [(Bool, a)]+        markInit [] = []+        markInit (x : []) = [(False, x)]+        markInit (x : xs) = (True, x) : markInit xs+    -- NOTE When in a single-line layout, there is a chance that the inner+    -- 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+        (\(m, i) -> (if m then br else id) $ p_item i)+        (markInit $ sortOn ssStart items)+  HsValBinds NoExt _ -> notImplemented "HsValBinds"+  HsIPBinds NoExt (IPBinds NoExt xs) ->+    -- Second argument of IPBind is always Left before type-checking.+    let p_ipBind (IPBind NoExt (Left name) expr) = do+          atom name+          space+          txt "="+          breakpoint+          useBraces $ inci $ located expr p_hsExpr+        p_ipBind _ = notImplemented "XHsIPBinds"+     in sepSemi (located' p_ipBind) xs+  HsIPBinds NoExt _ -> notImplemented "HsIpBinds"+  EmptyLocalBinds NoExt -> return ()+  XHsLocalBindsLR _ -> notImplemented "XHsLocalBindsLR"++p_hsRecField ::+  HsRecField' RdrName (LHsExpr GhcPs) ->+  R ()+p_hsRecField = \HsRecField {..} -> do+  p_rdrName hsRecFieldLbl+  unless hsRecPun $ do+    space+    txt "="+    let placement = exprPlacement (unLoc hsRecFieldArg)+    placeHanging placement $ located hsRecFieldArg p_hsExpr++p_hsTupArg :: HsTupArg GhcPs -> R ()+p_hsTupArg = \case+  Present NoExt x -> located x p_hsExpr+  Missing NoExt -> pure ()+  XTupArg {} -> notImplemented "XTupArg"++p_hsExpr :: HsExpr GhcPs -> R ()+p_hsExpr = p_hsExpr' N++p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()+p_hsExpr' s = \case+  HsVar NoExt name -> p_rdrName name+  HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"+  HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"+  HsRecFld NoExt x ->+    case x of+      Unambiguous NoExt name -> p_rdrName name+      Ambiguous NoExt name -> p_rdrName name+      XAmbiguousFieldOcc NoExt -> notImplemented "XAmbiguousFieldOcc"+  HsOverLabel NoExt _ v -> do+    txt "#"+    atom v+  HsIPVar NoExt (HsIPName name) -> do+    txt "?"+    atom name+  HsOverLit NoExt v -> atom (ol_val v)+  HsLit NoExt lit ->+    case lit of+      HsString (SourceText stxt) _ -> p_stringLit stxt+      HsStringPrim (SourceText stxt) _ -> p_stringLit stxt+      r -> atom r+  HsLam NoExt mgroup ->+    p_matchGroup Lambda mgroup+  HsLamCase NoExt mgroup -> do+    txt "\\case"+    breakpoint+    inci (p_matchGroup LambdaCase mgroup)+  HsApp NoExt 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 :| map getLoc initp+        -- Hang the last argument only if the initial arguments spans 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+        useBraces $ do+          located func (p_hsExpr' s)+          breakpoint+          inci $ sep breakpoint (located' p_hsExpr) initp+        inci $ 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 a e -> do+    located e p_hsExpr+    breakpoint+    inci $ do+      txt "@"+      located (hswc_body a) p_hsType+  OpApp NoExt x op y -> do+    let opTree = OpBranch (exprOpTree x) op (exprOpTree y)+    p_exprOpTree True s (reassociateOpTree getOpName opTree)+  NegApp NoExt e _ -> do+    txt "-"+    space+    located e p_hsExpr+  HsPar NoExt e ->+    parens s (located e (dontUseBraces . p_hsExpr))+  SectionL NoExt x op -> do+    located x p_hsExpr+    breakpoint+    inci (located op p_hsExpr)+  SectionR NoExt op x -> do+    located op p_hsExpr+    breakpoint+    inci (located x p_hsExpr)+  ExplicitTuple NoExt args boxity -> do+    let isSection = any (isMissing . unLoc) args+        isMissing = \case+          Missing NoExt -> 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 NoExt tag arity e ->+    p_unboxedSum N tag arity (located e p_hsExpr)+  HsCase NoExt e mgroup ->+    p_case exprPlacement p_hsExpr e mgroup+  HsIf NoExt _ if' then' else' ->+    p_if exprPlacement p_hsExpr if' then' else'+  HsMultiIf NoExt guards -> do+    txt "if"+    breakpoint+    inci . sitcc $ sep newline (located' (p_grhs RightArrow)) guards+  HsLet NoExt localBinds e ->+    p_let p_hsExpr localBinds e+  HsDo NoExt ctx es -> do+    let doBody header = do+          txt header+          breakpoint+          ub <- layoutToBraces <$> getLayout+          inci $+            sepSemi+              (located' (ub . 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+            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of+                FieldOcc _ n -> n+                XFieldOcc _ -> notImplemented "XFieldOcc"+            }+        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+    breakpoint+    let updName f =+          f+            { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of+                Ambiguous _ n -> n+                Unambiguous _ n -> n+                XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"+            }+    inci . braces N . sitcc $+      sep+        (comma >> breakpoint)+        (sitcc . located' (p_hsRecField . updName))+        rupd_flds+  ExprWithTySig affix x -> sitcc $ do+    located x p_hsExpr+    space+    txt "::"+    breakpoint+    inci $ do+      let HsWC {..} = affix+          HsIB {..} = hswc_body+      located hsib_body p_hsType+  ArithSeq NoExt _ x -> do+    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 NoExt _ name x -> do+    txt "{-# SCC "+    atom name+    txt " #-}"+    breakpoint+    located x p_hsExpr+  HsCoreAnn NoExt _ value x -> do+    txt "{-# CORE "+    atom value+    txt " #-}"+    breakpoint+    located x p_hsExpr+  HsBracket NoExt x -> p_hsBracket x+  HsRnBracketOut {} -> notImplemented "HsRnBracketOut"+  HsTcBracketOut {} -> notImplemented "HsTcBracketOut"+  HsSpliceE NoExt splice -> p_hsSplice splice+  HsProc NoExt 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)+  HsArrApp NoExt body input arrType cond ->+    p_hsCmd (HsCmdArrApp NoExt body input arrType cond)+  HsArrForm NoExt form mfixity cmds ->+    p_hsCmd (HsCmdArrForm NoExt form Prefix mfixity cmds)+  HsTick {} -> notImplemented "HsTick"+  HsBinTick {} -> notImplemented "HsBinTick"+  HsTickPragma {} -> notImplemented "HsTickPragma"+  -- These four constructs should never appear in correct programs.+  -- See: https://github.com/tweag/ormolu/issues/343+  EWildPat NoExt -> txt "_"+  EAsPat NoExt n p -> do+    p_rdrName n+    txt "@"+    located p p_hsExpr+  EViewPat NoExt p e -> do+    located p p_hsExpr+    space+    txt "->"+    breakpoint+    inci (located e p_hsExpr)+  ELazyPat NoExt p -> do+    txt "~"+    located p p_hsExpr+  HsWrap {} -> notImplemented "HsWrap"+  XExpr {} -> notImplemented "XExpr"++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+            txt "="+            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 NoExt) = notImplemented "XPatSynBind"++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"+    located then' $ \x ->+      placeHanging (placer x) (render x)+    breakpoint+    txt "else"+    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 NoExt -> txt "_"+  VarPat NoExt name -> p_rdrName name+  LazyPat NoExt pat -> do+    txt "~"+    located pat p_pat+  AsPat NoExt name pat -> do+    p_rdrName name+    txt "@"+    located pat p_pat+  ParPat NoExt pat ->+    located pat (parens S . p_pat)+  BangPat NoExt pat -> do+    txt "!"+    located pat p_pat+  ListPat NoExt pats -> do+    brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats+  TuplePat NoExt 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 NoExt 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 n -> (Just <$> take n fields) ++ [Nothing]+      InfixCon x y -> do+        located x p_pat+        space+        p_rdrName pat+        breakpoint+        inci (located y p_pat)+  ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer?+  ViewPat NoExt expr pat -> sitcc $ do+    located expr p_hsExpr+    space+    txt "->"+    breakpoint+    inci (located pat p_pat)+  SplicePat NoExt splice -> p_hsSplice splice+  LitPat NoExt p -> atom p+  NPat NoExt v _ _ -> located v (atom . ol_val)+  NPlusKPat NoExt n k _ _ _ -> sitcc $ do+    p_rdrName n+    breakpoint+    inci $ do+      txt "+"+      space+      located k (atom . ol_val)+  SigPat hswc pat -> do+    located pat p_pat+    p_typeAscription hswc+  CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage+  XPat NoExt -> notImplemented "XPat"++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+    txt "="+    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 NoExt deco _ expr -> p_hsSpliceTH True expr deco+  HsUntypedSplice NoExt deco _ expr -> p_hsSpliceTH False expr deco+  HsQuasiQuote NoExt _ quoterName srcSpan str -> do+    txt "["+    p_rdrName (L srcSpan quoterName)+    txt "|"+    -- NOTE QuasiQuoters often rely on precise custom strings. We cannot do+    -- any formatting here without potentially breaking someone's code.+    atom str+    txt "|]"+  HsSpliced {} -> notImplemented "HsSpliced"+  XSplice {} -> notImplemented "XSplice"++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 NoExt expr -> do+    anns <- getEnclosingAnns+    let name = case anns of+          AnnOpenEQ : _ -> ""+          _ -> "e"+    quote name (located expr p_hsExpr)+  PatBr NoExt pat -> quote "p" (located pat p_pat)+  DecBrL NoExt decls -> quote "d" (p_hsDecls Free decls)+  DecBrG NoExt _ -> notImplemented "DecBrG" -- result of renamer+  TypBr NoExt ty -> quote "t" (located ty p_hsType)+  VarBr NoExt 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 NoExt expr -> do+    txt "[||"+    breakpoint'+    located expr p_hsExpr+    breakpoint'+    txt "||]"+  XBracket {} -> notImplemented "XBracket"+  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 NoExt guards body) =+  combineSrcSpans' $ getLoc body :| map getLoc guards+getGRHSSpan (XGRHS NoExt) = notImplemented "XGRHS"++-- | 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 NoExt _ (L _ x)))] = placer x+blockPlacement _ _ = Normal++-- | Check if given command has a hanging form.+cmdPlacement :: HsCmd GhcPs -> Placement+cmdPlacement = \case+  HsCmdLam NoExt _ -> Hanging+  HsCmdCase NoExt _ _ -> Hanging+  HsCmdDo NoExt _ -> Hanging+  _ -> Normal++cmdTopPlacement :: HsCmdTop GhcPs -> Placement+cmdTopPlacement = \case+  HsCmdTop NoExt (L _ x) -> cmdPlacement x+  XCmdTop {} -> notImplemented "XCmdTop"++-- | Check if given expression has a hanging form.+exprPlacement :: HsExpr GhcPs -> Placement+exprPlacement = \case+  -- Only hang lambdas with single line parameter lists+  HsLam NoExt mg -> case mg of+    MG _ (L _ [L _ (Match NoExt _ (x : xs) _)]) _+      | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) ->+        Hanging+    _ -> Normal+  HsLamCase NoExt _ -> Hanging+  HsCase NoExt _ _ -> Hanging+  HsDo NoExt DoExpr _ -> Hanging+  HsDo NoExt MDoExpr _ -> Hanging+  RecordCon NoExt _ _ -> Hanging+  -- If the rightmost expression in an operator chain is hanging, make the+  -- whole block hanging; so that we can use the common @f = foo $ do@+  -- style.+  OpApp NoExt _ _ y -> exprPlacement (unLoc y)+  -- Same thing for function applications (usually with -XBlockArguments)+  HsApp NoExt _ y -> exprPlacement (unLoc y)+  HsProc NoExt (L s _) _ ->+    -- Indentation breaks if pattern is longer than one line and left+    -- hanging. Consequently, only apply hanging when it is safe.+    if isOneLineSpan s+      then Hanging+      else Normal+  _ -> Normal++withGuards :: [LGRHS GhcPs (Located body)] -> Bool+withGuards = any (checkOne . unLoc)+  where+    checkOne :: GRHS GhcPs (Located body) -> Bool+    checkOne (GRHS NoExt [] _) = False+    checkOne _ = True++exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)+exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)+exprOpTree n = OpNode n++getOpName :: HsExpr GhcPs -> Maybe RdrName+getOpName = \case+  HsVar NoExt (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+  -- NOTE If the beginning of the first argument and the second argument+  -- are on the same line, and the second argument has a hanging form, use+  -- hanging placement.+  let placement =+        if isOneLineSpan+          (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y)))+          then case y of+            OpNode (L _ n) -> exprPlacement n+            _ -> Normal+          else Normal+      opWrapper = case unLoc op of+        EWildPat NoExt -> 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+  switchLayout [opTreeLoc x]+    $ ub+    $ p_exprOpTree (not gotDollar) s x+  let p_op = located op (opWrapper . p_hsExpr)+      p_y = switchLayout [opTreeLoc y] (p_exprOpTree True N y)+  if isDollarSpecial && gotDollar && placement == Normal && isOneLineSpan (opTreeLoc x)+    then do+      space+      p_op+      breakpoint+      inci p_y+    else placeHanging placement $ do+      p_op+      space+      p_y++-- | 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,51 @@+{-# 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+import Ormolu.Utils++p_warnDecls :: WarnDecls GhcPs -> R ()+p_warnDecls (Warnings NoExt _ warnings) =+  traverse_ (located' p_warnDecl) warnings+p_warnDecls XWarnDecls {} = notImplemented "XWarnDecls"++p_warnDecl :: WarnDecl GhcPs -> R ()+p_warnDecl (Warning NoExt functions warningTxt) =+  p_topLevelWarning functions warningTxt+p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"++p_moduleWarning :: WarningTxt -> R ()+p_moduleWarning wtxt = do+  let (pragmaText, lits) = warningText wtxt+  switchLayout (getLoc <$> lits) $ do+    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) $ do+    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,117 @@+{-# 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 HsImpExp (IE (..))+import Ormolu.Printer.Combinators+import Ormolu.Printer.Meat.Common+import Ormolu.Utils++p_hsmodExports :: [LIE GhcPs] -> R ()+p_hsmodExports [] = do+  txt "("+  breakpoint'+  txt ")"+p_hsmodExports xs =+  parens N . sitcc $ do+    layout <- getLayout+    sep breakpoint (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)++p_hsmodImport :: ImportDecl GhcPs -> R ()+p_hsmodImport ImportDecl {..} = do+  txt "import"+  space+  when ideclSource (txt "{-# SOURCE #-}")+  space+  when ideclSafe (txt "safe")+  space+  when ideclQualified (txt "qualified")+  space+  case ideclPkgQual of+    Nothing -> return ()+    Just slit -> atom slit+  space+  inci $ do+    located ideclName atom+    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 (sitcc . located' (uncurry (p_lie layout))) (attachPositions xs)+    newline+p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"++p_lie :: Layout -> (Int, Int) -> IE GhcPs -> R ()+p_lie encLayout (i, totalItems) = \case+  IEVar NoExt l1 -> do+    located l1 p_ieWrappedName+    p_comma+  IEThingAbs NoExt l1 -> do+    located l1 p_ieWrappedName+    p_comma+  IEThingAll NoExt l1 -> do+    located l1 p_ieWrappedName+    space+    txt "(..)"+    p_comma+  IEThingWith NoExt 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 NoExt l1 -> do+    located l1 p_hsmodName+    p_comma+  IEGroup NoExt n str -> do+    unless (i == 0) newline+    p_hsDocString (Asterisk n) False (noLoc str)+  IEDoc NoExt str ->+    p_hsDocString Pipe False (noLoc str)+  IEDocNamed NoExt str -> p_hsDocName str+  XIE NoExt -> notImplemented "XIE"+  where+    p_comma =+      case encLayout of+        SingleLine -> unless (i + 1 == totalItems) comma+        MultiLine -> comma++-- | Attach positions to 'Located' things in a list.+attachPositions ::+  [Located a] ->+  [Located ((Int, Int), a)]+attachPositions xs =+  let f i (L l x) = L l ((i, n), x)+      n = length xs+   in zipWith f [0 ..] xs
+ src/Ormolu/Printer/Meat/Module.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of modules.+module Ormolu.Printer.Meat.Module+  ( p_hsModule,+  )+where++import Control.Monad+import GHC+import Ormolu.Imports+import Ormolu.Parser.Pragma+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++p_hsModule :: [Pragma] -> ParsedSource -> R ()+p_hsModule pragmas (L moduleSpan HsModule {..}) = do+  -- NOTE If span of exports in multiline, the whole thing is multiline.+  -- This is especially important because span of module itself always seems+  -- to have length zero, so it's not reliable for layout selection.+  let exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports+      deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage+      spans' = exportSpans ++ deprecSpan ++ [moduleSpan]+  switchLayout spans' $ do+    p_pragmas pragmas+    newline+    forM_ hsmodHaddockModHeader (p_hsDocString Pipe True)+    case hsmodName of+      Nothing -> return ()+      Just hsmodName' -> do+        located hsmodName' p_hsmodName+        forM_ hsmodDeprecMessage $ \w -> do+          breakpoint+          located' p_moduleWarning w+        case hsmodExports of+          Nothing -> return ()+          Just hsmodExports' -> do+            breakpoint+            inci (p_hsmodExports (unLoc hsmodExports'))+        breakpoint+        txt "where"+        newline+    newline+    forM_ (sortImports hsmodImports) (located' p_hsmodImport)+    newline+    switchLayout (getLoc <$> hsmodDecls) $ do+      p_hsDecls Free hsmodDecls+      newline+      spitRemainingComments
+ src/Ormolu/Printer/Meat/Pragma.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-}++-- | Pretty-printing of language pragmas.+module Ormolu.Printer.Meat.Pragma+  ( p_pragmas,+  )+where++import qualified Data.Set as S+import qualified Data.Text as T+import Ormolu.Parser.Pragma (Pragma (..))+import Ormolu.Printer.Combinators++data PragmaTy = Language | OptionsGHC | OptionsHaddock+  deriving (Eq, Ord)++p_pragmas :: [Pragma] -> R ()+p_pragmas ps =+  let prepare = concatMap $ \case+        PragmaLanguage xs -> (Language,) <$> xs+        PragmaOptionsGHC x -> [(OptionsGHC, x)]+        PragmaOptionsHaddock x -> [(OptionsHaddock, x)]+   in mapM_ (uncurry p_pragma) (S.toAscList . S.fromList . prepare $ ps)++p_pragma :: PragmaTy -> String -> R ()+p_pragma ty c = do+  txt "{-# "+  txt $ case ty of+    Language -> "LANGUAGE"+    OptionsGHC -> "OPTIONS_GHC"+    OptionsHaddock -> "OPTIONS_HADDOCK"+  space+  txt (T.pack c)+  txt " #-}"+  newline
+ src/Ormolu/Printer/Meat/Type.hs view
@@ -0,0 +1,234 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- | Rendering of types.+module Ormolu.Printer.Meat.Type+  ( p_hsType,+    hasDocStrings,+    p_hsContext,+    p_hsTyVarBndr,+    p_conDeclFields,+    tyVarsToTypes,+  )+where++import BasicTypes+import GHC+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) t++p_hsType' :: Bool -> HsType GhcPs -> R ()+p_hsType' multilineArgs = \case+  HsForAllTy NoExt bndrs t -> do+    txt "forall "+    sep space (located' p_hsTyVarBndr) bndrs+    txt "."+    interArgBreak+    p_hsType' multilineArgs (unLoc t)+  HsQualTy NoExt 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 NoExt p n -> do+    case p of+      Promoted -> do+        txt "'"+        case showOutputable (unLoc n) of+          _ : '\'' : _ -> space+          _ -> return ()+      NotPromoted -> return ()+    p_rdrName n+  HsAppTy NoExt f x -> sitcc $ do+    located f p_hsType+    breakpoint+    inci (located x p_hsType)+  HsFunTy NoExt x y@(L _ y') -> do+    located x p_hsType+    space+    txt "->"+    interArgBreak+    case y' of+      HsFunTy {} -> p_hsTypeR y'+      _ -> located y p_hsTypeR+  HsListTy NoExt t ->+    located t (brackets N . p_hsType)+  HsTupleTy NoExt 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 NoExt xs ->+    parensHash N . sitcc $+      sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs+  HsOpTy NoExt x op y -> sitcc $ do+    let opTree = OpBranch (tyOpTree x) op (tyOpTree y)+     in p_tyOpTree (reassociateOpTree Just opTree)+  HsParTy NoExt (L _ t@HsKindSig {}) ->+    -- NOTE Kind signatures already put parentheses around in all cases, so+    -- skip this layer of parentheses. The reason for this behavior is that+    -- parentheses are not always encoded with 'HsParTy', but seem to be+    -- always necessary when we have kind signatures in place.+    p_hsType t+  HsParTy NoExt t ->+    parens N (located t p_hsType)+  HsIParamTy NoExt n t -> sitcc $ do+    located n atom+    space+    txt "::"+    breakpoint+    inci (located t p_hsType)+  HsStarTy NoExt _ -> txt "*"+  HsKindSig NoExt t k ->+    -- NOTE Also see the comment for 'HsParTy'.+    parens N . sitcc $ do+      located t p_hsType+      space -- FIXME+      txt "::"+      space+      inci (located k p_hsType)+  HsSpliceTy NoExt splice -> p_hsSplice splice+  HsDocTy NoExt t str -> do+    p_hsDocString Pipe True str+    located t p_hsType+  HsBangTy NoExt (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 NoExt fields ->+    p_conDeclFields fields+  HsExplicitListTy NoExt p xs -> do+    case p of+      Promoted -> 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+        (Promoted, ((L _ t) : _)) | isPromoted t -> space+        _ -> return ()+      sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs+  HsExplicitTupleTy NoExt xs -> do+    txt "'"+    parens N $ do+      case xs of+        ((L _ t) : _) | isPromoted t -> space+        _ -> return ()+      sep (comma >> breakpoint) (located' p_hsType) xs+  HsTyLit NoExt t ->+    case t of+      HsStrTy (SourceText s) _ -> p_stringLit s+      a -> atom a+  HsWildCardTy NoExt -> txt "_"+  XHsType (NHsCoreTy t) -> atom t+  where+    isPromoted = \case+      HsTyVar _ Promoted _ -> True+      HsExplicitListTy _ _ _ -> True+      HsExplicitTupleTy _ _ -> True+      _ -> False+    interArgBreak =+      if multilineArgs+        then newline+        else breakpoint+    p_hsTypeR = p_hsType' multilineArgs++-- | 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 NoExt x ->+    p_rdrName x+  KindedTyVar NoExt l k -> parens N $ do+    located l atom+    space+    txt "::"+    breakpoint+    inci (located k p_hsType)+  XTyVarBndr NoExt -> notImplemented "XTyVarBndr"++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 NoExt) = notImplemented "XConDeclField"++tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName)+tyOpTree (L _ (HsOpTy NoExt 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] $ do+    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 {} -> notImplemented "XLHsQTyVars"++tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs+tyVarToType = \case+  UserTyVar NoExt tvar -> HsTyVar NoExt NotPromoted tvar+  KindedTyVar NoExt tvar kind ->+    HsParTy NoExt $ noLoc $+      HsKindSig NoExt (noLoc (HsTyVar NoExt NotPromoted tvar)) kind+  XTyVarBndr {} -> notImplemented "XTyVarBndr"
+ src/Ormolu/Printer/Operators.hs view
@@ -0,0 +1,182 @@+{-# 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 BasicTypes (Fixity (..), SourceText (NoSourceText), compareFixity, defaultFixity)+import Data.Function (on)+import Data.List+import Data.Maybe (fromMaybe)+import GHC+import OccName (mkVarOcc)+import RdrName (mkRdrUnqual)+import SrcLoc (combineSrcSpans)++-- | 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 ..]+    . groupBy (doubleWithinEps 0.00001 `on` snd)+    . (overrides ++)+    . avgScores+    $ 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 =+            if le < ob+              then-- 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)+              else-- if the operator is in the end of the line, assign the+              -- score 1.++                if oe < rb+                  then 1+                  else 2 -- otherwise, assign a high score.+      return $ (opName, s) : score r+    avgScores :: [(RdrName, Double)] -> [(RdrName, Double)]+    avgScores =+      sortOn snd+        . map (\xs@((n, _) : _) -> (n, avg $ map snd xs))+        . groupBy ((==) `on` fst)+        . sort+    avg :: [Double] -> Double+    avg i = sum i / fromIntegral (length i)+    -- 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+            ]+    unSrcSpan (RealSrcSpan r) = Just r+    unSrcSpan (UnhelpfulSpan _) = Nothing++----------------------------------------------------------------------------+-- 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, Data e1) =>+      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/Utils.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Random utilities used by the code.+module Ormolu.Utils+  ( combineSrcSpans',+    isModule,+    notImplemented,+    showOutputable,+    splitDocString,+  )+where++import Data.Data (Data, showConstr, toConstr)+import Data.List (dropWhileEnd)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Text (Text)+import qualified Data.Text as T+import HsDoc (HsDocString, unpackHDS)+import qualified Outputable as GHC+import SrcLoc++-- | Combine all source spans from the given list.+combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan+combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs++-- | Return 'True' if given element of AST is module.+isModule :: Data a => a -> Bool+isModule x = showConstr (toConstr x) == "HsModule"++-- | Placeholder for things that are not yet implemented.+notImplemented :: String -> a+notImplemented msg = error $ "not implemented yet: " ++ msg++-- | Pretty-print an 'GHC.Outputable' thing.+showOutputable :: GHC.Outputable o => o -> String+showOutputable = GHC.showSDocUnsafe . 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
+ 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 = do+  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,94 @@+{-# 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 System.FilePath (addExtension, dropExtensions, splitExtensions)+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) = 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 $+    addExtension (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 idempotencyTest actual expected =+  when (actual /= expected) . expectationFailure $+    unlines+      [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):",+        T.unpack expected,+        ">>>>>>>>>>>>>>>>>>>>>> but got:",+        T.unpack actual+      ]+  where+    pass =+      if idempotencyTest+        then "idempotency 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 #-}