ormolu-0.1.2.0/0000755000000000000000000000000007346545000011356 5ustar0000000000000000ormolu-0.1.2.0/CHANGELOG.md0000644000000000000000000002216707346545000013177 0ustar0000000000000000## Ormolu 0.1.2.0 * Fixed the bug when comments in different styles got glued together after formatting. [Issue 589](https://github.com/tweag/ormolu/issues/589). * Added `-i` as a shortcut for `--mode inplace`. [Issue 467](https://github.com/tweag/ormolu/issues/467). * Improved grouping of top-level declarations. [Issue 466](https://github.com/tweag/ormolu/issues/466). ## Ormolu 0.1.1.0 * Imports in a import lists are now normalized: duplicate imports are combined/eliminated intelligently. * Import declarations that can be merged are now automatically merged. [Issue 414](https://github.com/tweag/ormolu/issues/414). * The magic comments for disabling and enabling Ormolu now can encompass any fragment of code provided that the remaining code after exclusion of the disabled part is still syntactically correct. [Issue 601](https://github.com/tweag/ormolu/issues/601). * Improved sorting of operators in imports. [Issue 602](https://github.com/tweag/ormolu/issues/602). * Fixed a bug related to trailing space in multiline comments in certain cases. [Issue 603](https://github.com/tweag/ormolu/issues/602). * Added support for formatting linked lists with `(:)` as line terminator. [Issue 478](https://github.com/tweag/ormolu/issues/478). * Fixed rendering of function arguments in multiline layout. [Issue 609](https://github.com/tweag/ormolu/issues/609). * Blank lines between definitions in `let` and `while` bindings are now preserved. [Issue 554](https://github.com/tweag/ormolu/issues/554). * Fixed the bug when type applications stuck to the `$` of TH splices that followed them. [Issue 613](https://github.com/tweag/ormolu/issues/613). * Improved region formatting so that indented fragments—such as definitions inside of `where` clauses—can be formatted. [Issue 572](https://github.com/tweag/ormolu/issues/572). * Fixed the bug related to the de-association of pragma comments. [Issue 619](https://github.com/tweag/ormolu/issues/619). ## Ormolu 0.1.0.0 * Fixed rendering of type signatures concerning several identifiers. [Issue 566](https://github.com/tweag/ormolu/issues/566). * Fixed an idempotence issue with inline comments in tuples and parentheses. [Issue 450](https://github.com/tweag/ormolu/issues/450). * Fixed an idempotence issue when certain comments were picked up as “continuation” of a series of comments [Issue 449](https://github.com/tweag/ormolu/issues/449). * Fixed an idempotence issue related to different indentation levels in a comment series. [Issue 512](https://github.com/tweag/ormolu/issues/512). * Fixed an idempotence issue related to comments which may happen to be separated from the elements they are attached to by the equality sign. [Issue 340](https://github.com/tweag/ormolu/issues/340). * Fixed an idempotence issue with type synonym and data declarations where the type has a Haddock. [Issue 578](https://github.com/tweag/ormolu/issues/578). * Fix the false positive about AST differences in presence of comments with multiple blank lines in a row. [Issue 518](https://github.com/tweag/ormolu/issues/518). * Fixed rendering of comments around if expressions. [Issue 458](https://github.com/tweag/ormolu/issues/458). * Unnamed fields of data constructors are now documented using the `-- ^` syntax. [Issue 445](https://github.com/tweag/ormolu/issues/445) and [Issue 428](https://github.com/tweag/ormolu/issues/428). * Fixed non-idempotent transformation of partly documented data definition. [Issue 590](https://github.com/tweag/ormolu/issues/590). * Fixed an idempotence issue related to operators. [Issue 522](https://github.com/tweag/ormolu/issues/522). * Renamed the `--check-idempotency` flag to `--check-idempotence`. Apparently only the latter is correct. ## Ormolu 0.0.5.0 * Grouping of statements in `do`-blocks is now preserved. [Issue 74](https://github.com/tweag/ormolu/issues/74). * Grouping of TH splices is now preserved. [Issue 507](https://github.com/tweag/ormolu/issues/507). * Comments on pragmas are now preserved. [Issue 216](https://github.com/tweag/ormolu/issues/216). * Ormolu can now be enabled and disabled via special comments. [Issue 435](https://github.com/tweag/ormolu/issues/435). * Added experimental support for simple CPP. [Issue 415](https://github.com/tweag/ormolu/issues/415). * Added two new options `--start-line` and `--end-line` that allow us to select a region to format. [Issue 516](https://github.com/tweag/ormolu/issues/516). * Fixed rendering of module headers in the presence of preceding comments or Haddocks. [Issue 561](https://github.com/tweag/ormolu/issues/561). ## Ormolu 0.0.4.0 * When given several files to format, Ormolu does not stop on the first failure, but tries to format all the files. [Issue 502](https://github.com/tweag/ormolu/issues/502). * Made rendering of pattern matches involving operators consistent with other cases of rendering of operators. [Issue 500](https://github.com/tweag/ormolu/issues/500). * More compact rendering of type family injectivity constraints. [Issue 482](https://github.com/tweag/ormolu/issues/482). * Improved rendering of the keyword `where` in class, data, and type family declarations. When headers of these declarations are multi-line `where` is now put on its own line. [Issue 509](https://github.com/tweag/ormolu/issues/509). * Fixed the bug pertaining to rendering of arrow notation with multiline expressions. [Issue 513](https://github.com/tweag/ormolu/issues/513). * Made rendering of data type definitions, value-level applications, and application of types use the same style. Moreover, existential now doesn't cause the data constructor be unconditionally rendered in multiline layout. [Issue 427](https://github.com/tweag/ormolu/issues/427). * Records with a single data constructor are now formatted more compactly. [Issue 425](https://github.com/tweag/ormolu/issues/425). * Switched to `ghc-lib-parser-8.10.1`. * Implemented support for the new language extensions `ImportQualifiedPost` and `StandaloneKindSignatures`. ## Ormolu 0.0.3.1 * Fixed rendering of record updates with the record dot preprocessor syntax [Issue 498](https://github.com/tweag/ormolu/issues/498). ## Ormolu 0.0.3.0 * Fixed an issue related to unnecessary use of curly braces. [Issue 473](https://github.com/tweag/ormolu/issues/473). * Fixed the issue with formatting multi-way if when it happens to be a function applied to arguments [Issue 488](https://github.com/tweag/ormolu/issues/488). This changed the way multi-line if is formatted in general. * Added support for record dot pre-processor when used via the plugin. [Issue 486](https://github.com/tweag/ormolu/issues/486). * Stopped hanging record constructors and improved placing potentially-hanging consturctions in the presence of comments. [Issue 447](https://github.com/tweag/ormolu/issues/447). * Fixed indentation in presence of type applications. [Issue 493](https://github.com/tweag/ormolu/issues/493). * Class and instance declarations now do not have a blank line after `where`. Grouping of methods from the original input is also preserved with some normalizations. [Issue 431](https://github.com/tweag/ormolu/issues/431). ## Ormolu 0.0.2.0 * Switched to `ghc-lib-parser` instead of depending on the `ghc` package directly. This should allow us to use newest features of GHC while not necessarily depending on the newest version of the compiler. In addition to that Ormolu is now GHCJS-compatible. * Now unrecognized GHC options passed with `--ghc-opt` cause Ormolu to fail (exit code 7). * Fixed formatting of result type in closed type families. See [issue 420](https://github.com/tweag/ormolu/issues/420). * Fixed a minor inconsistency between formatting of normal and foreign type signatures. See [issue 408](https://github.com/tweag/ormolu/issues/408). * Fixed a bug when comment before module header with Haddock was moved inside the export list. See [issue 430](https://github.com/tweag/ormolu/issues/430). * Empty `forall`s are now correctly preserved. See [issue 429](https://github.com/tweag/ormolu/issues/429). * Fixed [issue 446](https://github.com/tweag/ormolu/issues/446), which involved braces and operators. * When there are comments between preceding Haddock (pipe-style) and its corresponding declaration they are preserved like this in the output instead of being shifted. To be clear, this is not a very good idea to have comments in that position because the Haddock will end up not being associated with the declarations. Issues [440](https://github.com/tweag/ormolu/issues/440) and [448](https://github.com/tweag/ormolu/issues/448). * Implemented correct handling of shebangs. [Issue 377](https://github.com/tweag/ormolu/issues/377). * Implemented correct handling of stack headers. [Issue 393](https://github.com/tweag/ormolu/issues/393). * Sorting language pragmas cannot not change meaning of the input program anymore. [Issue 404](https://github.com/tweag/ormolu/issues/404). * Fixed formatting of applications where function is a complex expression. [Issue 444](https://github.com/tweag/ormolu/issues/444). ## Ormolu 0.0.1.0 * Initial release. ormolu-0.1.2.0/CONTRIBUTING.md0000644000000000000000000000437507346545000013620 0ustar0000000000000000# 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: `.hs` for input and `-out.hs` for corresponding expected output. Testing is performed as following: * Given snippet of source code is parsed and pretty-printed. * The result of printing is parsed back again and the AST is compared to the AST obtained from the original file. They should match. * The output of printer is checked against the expected output. * Idempotence property is verified: formatting already formatted code results in exactly the same output. Examples can be organized in sub-directories, see the existing ones for inspiration. Please note that we try to keep individual files at most 25 lines long because otherwise it's hard to figure out want went wrong when a test fails. ## CI We use Circle CI. Some outside contributors may have problems, as in, CI won't run for PRs opened from forks with “unauthorized” errors. In that case the best we can do is to add you as a contributor or to restart your build manually. If you have been added as a contributor but the builds still do not start, try clicking ``` User settings -> Account integrations -> Refresh permissions ``` in Circle CI app. ## Formatting Use `format.sh` script to format Ormolu with current version of Ormolu. If Ormolu is not formatted like this, the CI will fail. [issues]: https://github.com/tweag/ormolu/issues [bugs]: https://github.com/tweag/ormolu/issues?q=is%3Aissue+is%3Aopen+label%3Abug ormolu-0.1.2.0/DESIGN.md0000644000000000000000000003602707346545000012661 0ustar0000000000000000# Ormolu *This document represents our discussions and plans at early stages of development, it is no longer being updated.* * [Analysis of the existing solutions](#analysis-of-the-existing-solutions) * [Brittany](#brittany) * [Hindent](#hindent) * [Stylish Haskell](#stylish-haskell) * [Haskell formatter](#haskell-formatter) * [Proposed design](#proposed-design) * [Parsing](#parsing) * [CPP](#cpp) * [Printing](#printing) * [Configuration](#configuration) * [Handling of language extensions](#handling-of-language-extensions) * [Testing](#testing) * [Functionality of executable](#functionality-of-executable) * [Why not contribute to/fork Hindent or Brittany?](#why-not-contribute-tofork-hindent-or-brittany) * [Examples](#examples) This document describes design of a new formatter for Haskell source code. It also includes recommendations for future implementers. We set for the following goals (mostly taken from [brittany](https://github.com/lspitzner/brittany)): * Preserve the meaning of the formatted functions when no CPP is used; * Make reasonable use of screen space; * Use linear space and computation time on the size of the input; * Preserve comments; * Be idempotent. ## Analysis of the existing solutions In order to design a new formatter we need to study the existing solutions so we can borrow the good bits and avoid making the same mistakes. ### Brittany [Brittany][brittany] builds on top of [`ghc-exactprint`][ghc-exactprint]—a library that uses parser of GHC itself for parsing and thus it guarantees that at least parsing phase is bug-free (which is admittedly the cause of majority of bugs in other projects, see below). After parsing, Haskell AST and a collection of annotations are available. The annotations are there because Haskell AST doesn't provide enough information to reconstruct source code (for example it doesn't include comments). The AST and the annotations are converted into a `BriDoc` value. A `BriDoc` value is a document representation like the `Doc` from the [pretty][pretty-doc] or the [wl-pprint][wl-pprint-doc] libraries. Brittany implements its own document type in an attempt to find a satisfactory rendering of the source code that fits a page-width constraint. Because of this, a `BriDoc` value represents a collection of many candidate layouts (i.e. renderings) of the source code. This collection is pruned until it contains a single layout. The structure of the chosen layout is then adjusted to leave it in a form which can be easily traversed to produce the final rendering. Brittany invests the majority of its implementation to manage the `BriDoc` values. Given that the amount of possible layouts is exponential, the representation is clever enough to fit them in linear space. There are multiple ways to build a `BriDoc`, not all of which fit in linear space. So care is necessary to keep memory bounded. The compexities of the `BriDoc` structure, together with the lack of documentation, make Brittany at least challenging to maintain. ### Hindent [Hindent][hindent] uses [`haskell-src-exts`][haskell-src-exts] for parsing like all older projects. `haskell-src-exts` does not use parser of GHC itself, and is a source of endless parsing bugs. `Hindent` is affected by these upstream issues as well as Stylish Haskell and Haskell formatter (see below). This already makes all these projects unusable with some valid Haskell source code, but let's continue studying Hindent anyway. Hindent is quite different from Brittany in the sense that it does not attempt to build a document representation to render afterwards, instead it just prints the parsed code straight away. This means that the 70-80% of what the code does is a printing traversal. Hindent code is easier to read and debug. Pretty-printing functions are very straightforward. If there is a bug (in pretty-printer, not in parser which Hindent cannot control), it's easy to fix AFAIU. Hindent is also notable for its ability to handle CPP and inputs that do not constitute complete modules. It splits input stream into so-called “code blocks” recognizing CPP macros and then only pretty-prints “normal code” without touching CPP directives. After that CPP is inserted between pretty-printed blocks of source code. The approach fails when CPP breaks code in such a way that separate blocks do not form valid Haskell expressions, see [this](https://github.com/commercialhaskell/hindent/issues/383) for example. Looking at the bug tracker there are many bugs. Part of them is because of the use of `haskell-src-exts`, the other part is because the maintainer doesn't care (anymore?) and doesn't fix them. Well it's as simple as that, with any sort of commercial backing the bugs in pretty printer would be fixed long time ago. ### Stylish Haskell [Stylish Haskell][stylish-haskell] also uses `haskell-src-exts` and suffers from the same upstream problems. I haven't studied the transformations it performs, but it looks like it transforms the parsed source code partially by manipulating AST and partially by manipulating raw text (e.g. to drop trailing whitspace from each line). CPP Macros are just filtered out silently as a preprocessing step before feeding the code to `haskell-src-exts`. Stylish Haskell is not so invasive as the other formatters and most reported bugs are about parsing issues and CPP. As I understand it, people mostly use it to screw their import lists. ### Haskell formatter [Haskell formatter][haskell-formatter] is an older project that didn't get much traction. It also uses `haskell-src-ext` and also tries to do manipulations on the parsed AST. The issue tracker doesn't have many issues probably because it never got popular enough (only 15 stars on GitHub). All the issues are about upstream problems with `haskell-src-exts`. ## Proposed design This section describes a solution that combines all the good things from the projects above. ### Parsing and CPP It is clear that `ghc-exactprint` is better than `haskell-src-exts`, so we should use that. If we go with `ghc-exactprint` though, we'll need to specify which parser to use, e.g. the parser that parses whole module or the one which parsers declarations/expressions/etc. It seems that in general it's better to use the parser for modules because it should work with all input files containing complete modules, while with other parsers it's impossible to guess what they'll be called on. ### CPP We allow CPP directives in the input, but we forgo the goal to preserve the meaning of the formatted functions in that case. Instead of supporting CPP better, we hope for a solution to replace CPP to do conditional compilation. There are the following challenges when formatting a module with CPP: * GHC parser won't accept anything but a valid, complete module. Therefore, formatting the Haskell code between CPP directives is not an option. * Ignoring the CPP directives and formatting the Haskell code can change its meaning. An example follows. Let's suppose that we want to format the following program: ``` $ cat test.hs {-# LANGUAGE CPP #-} main = print (g && f1) where f1 = h where h = True #ifdef C1 g = g1 where g1 = g2 where g2 = False #else g = True #endif #ifndef C1 g = False #endif $ runhaskell test.hs True ``` At the time of this writing, formatting this program with Hindent or Ormolu produces the same output we would get if the CPP directives were considered comments: ``` $ ormolu --version ormolu 0.0.5.0 HEAD fc64eada5c4da7a5b07d2872e253671b48aec115 using ghc-lib-parser 8.10.1.20200412 $ ormolu --mode inplace test.hs $ cat test.hs {-# LANGUAGE CPP #-} main = print (g && f1) where f1 = h where h = True #ifdef C1 g = g1 where g1 = g2 where g2 = False #else g = True #endif #ifndef C1 g = False #endif $ runhaskell test.hs False ``` Running the formatter causes the output of the program to change from `True` to `False` when `C1` is not defined. A solution could be to make the formatter more careful with CPP directives, constraining how directives can be inserted in Haskell code to avoid changing the meaning by reformatting. But this would introduce additional complexity, and the problem would need to be solved repeteadly for every tool out there which wants to parse Haskell modules. If CPP is replaced with some language extension or mechanism to do conditional compilation, all tools will benefit from it. ### Printing Just pretty-printing code (following the approach of Hindent) seems sane. It is straightforward and when complemented with enough tests (see the section about testing below), it should work all right. Implementation can be just a `Reader` monad producing something like text builder. The context of `Reader` can store current indentation and configuration options. As the pretty-printing library we can use [`Outputable`][outputable] (and `SDoc`) from the [`ghc`][ghc] package itself (at least for pretty-printing basic things like floating point literals and the like). The benefit is that AST components that we'll want to print are already instances of `Outputable`, so we'll get correct renderings for free. In order to keep the output of the formatter simple, fast and correct, we introduce the following rule. The pretty-printing code can be in control of every formatting choice, except for two, which are left to the programmer: 1. location of comments (comments are going to be attached to specific syntactic entities, so moving an entity will move its comment too), 2. line breaking. Regarding (2), the idea is that given any syntactic entity, the programmer has a choice: 1. write it on one line, or 2. write it on two lines or more. If (1), then everything is kept in one line. If (2), i.e. a line break appears somewhere in the concrete syntax tree (CST), then additional line breaks are introduced everywhere possible in parent nodes, *but not in any sibling or children nodes*. Examples: ```haskell -- Stays as is. data T = A | B data T = A | B -- Is reformatted to: data T = A | B -- Stays as is. map :: (a -> b) -> [a] -> [b] foldr :: (a -> b -> b) -> b -> [a] -> [b] -- Is reformatted to: foldr :: (a -> b -> b) -> b -> [a] -> [b] t = let x = foo bar baz in foo bar baz -- Is reformatted to: t = let x = foo bar baz in foo far baz ``` Crucially, no effort is made to fit within reasonable line lengths. That's up to the programmer. Style will still be consistent for everyone in every other aspect, and that's what counts. ### Configuration We are not allowing to configure any aspect of the formatter. A module might be used in multiple projects, and we prefer to have it formatted the same in all of them. See this [this post][hindent-5-blog] by Chris Done (the author of Hindent) which says that as long as the default style is conventional and good it doesn't really matter how code gets formatted. Consistency is more important. ### Handling of language extensions Some language extensions affect how parsing is done. We are going to deal with those in two ways: * When language pragmas are present in source file, we must parse them before we run the main parser (I guess) and they should determine how the main parsing will be done. * There also should be configuration file that may enable other language extensions to be used on all files. * Later we could try to locate Cabal files and fetch the list of extensions that are enabled by default from there. ### Testing It should be possible to add tests incrementally as we develop pretty-printing code and new issues are discovered. For each Haskell module that we want to test, we perform the following steps: 1. Given input snippet of source code parse it and pretty print it. 2. Parse the result of pretty-printing again and make sure that AST is the same as AST of original snippet module span positions. We could make this part of a self-check in the formatter. 3. Check the output against expected output. Thus all tests should include two files: input and expected output. 4. Check that running the formatter on the output produces the same output again (the transformation is idempotent). In order to grow our testsuite, we would borrow test cases from test suites of existing libraries like Brittany and Hindent. Then we may add test cases for opened issues that Brittany and Hindent have. When we're confident enough, we can start “mining” new issues by running the program on real source code from Hackage till we don't get new issues anymore. For every issue that we find this way, a test case should be added. ### Functionality of executable * In all cases the program should test if the produced AST is the same as the one we originally parsed and if it differs, an error should be displayed suggesting reporting this on our issue tracker. * Check mode: return non-zero exit code if any transformations would be applied. * Modification in place and printing of formatted code to stdout. * A flag for version/commit information. * An option to specify location of config file. * Options to specify parameters that come from config files on command line instead (currently this is just dynamic options enabled by default, such as langauge extensions). ### Why not contribute to/fork HIndent or Brittany? We want to simultaneously optimize three goals: 1. simplicity of implementation, 2. efficiency, 3. predictable and readable output that doesn't overuse vertical spacing. Hindent aims for (1) and (2) by still producing something palatable in (3). Brittany gives up on (1) but goes a long way towards (3) and presumably does OK on (2). Ormolu goes for (1), (2) and (3), by outsourcing the hard part of (3) to the user. Ormolu is less normative than Brittany, and less normative than Hindent, but arguably stills achieves consistent style. Forking or contributing to Hindent is not an option because if we replace `haskell-src-exts` with `ghc` (or `ghc-exact-print`) then we'll have to work with a different AST type and all the code in Hindent will become incompatible and there won't be much code to be re-used in that case. It is also possible that we'll find a nicer way to write pretty-printer. ## Examples A list of formatting examples can be found [here](data/examples). [brittany]: https://hackage.haskell.org/package/brittany [hindent]: https://hackage.haskell.org/package/hindent [hindent-5-blog]: https://chrisdone.com/posts/hindent-5 [stylish-haskell]: https://hackage.haskell.org/package/stylish-haskell [haskell-formatter]: https://hackage.haskell.org/package/haskell-formatter [ghc]: https://hackage.haskell.org/package/ghc [outputable]: https://hackage.haskell.org/package/ghc-8.4.3/docs/Outputable.html [haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts [ghc-exactprint]: https://hackage.haskell.org/package/ghc-exactprint [hindent-printer]: https://github.com/commercialhaskell/hindent/blob/master/src/HIndent/Pretty.hs [pretty-doc]: http://hackage.haskell.org/package/pretty-1.1.3.6/docs/Text-PrettyPrint.html#t:Doc [wl-pprint-doc]: http://hackage.haskell.org/package/wl-pprint-1.2.1/docs/Text-PrettyPrint-Leijen.html#t:Doc ormolu-0.1.2.0/LICENSE.md0000644000000000000000000000265207346545000012767 0ustar0000000000000000Copyright © 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. ormolu-0.1.2.0/README.md0000644000000000000000000001307407346545000012642 0ustar0000000000000000# 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) [![Build status](https://badge.buildkite.com/8e3b0951f3652b77e1c422b361904136a539b0522029156354.svg?branch=master)](https://buildkite.com/tweag-1/ormolu) 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-16.0 packages: - '.' $ stack build # to build $ stack install # to install ``` To use Ormolu directly from GitHub with Nix, this snippet may come in handy: ```nix # This overlay adds Ormolu straight from GitHub. self: super: let source = super.fetchFromGitHub { owner = "tweag"; repo = "ormolu"; rev = "de279d80122b287374d4ed87c7b630db1f157642"; # update as necessary sha256 = "0qrxfk62ww6b60ha9sqcgl4nb2n5fhf66a65wszjngwkybwlzmrv"; # as well }; ormolu = import source { pkgs = self; }; in { haskell = super.haskell // { packages = super.haskell.packages // { "${ormolu.ormoluCompiler}" = super.haskell.packages.${ormolu.ormoluCompiler}.override { overrides = ormolu.ormoluOverlay; }; }; }; } ``` ## Usage The following will print the formatted output to the standard output. ```console $ ormolu Module.hs ``` Add `--mode inplace` to replace the contents of the input file with the formatted output. ```console $ ormolu --mode inplace Module.hs ``` Use `find` to format a tree recursively: ```console $ ormolu --mode inplace $(find . -name '*.hs') ``` ## Magic comments Ormolu understands two magic comments: ```haskell {- ORMOLU_DISABLE -} ``` and ```haskell {- ORMOLU_ENABLE -} ``` This allows us to disable formatting selectively for code between these markers or disable it for the entire file. To achieve the latter, just put `{- ORMOLU_DISABLE -}` at the very top. Note that the source code should still be parseable even without the “excluded” part. Because of that the magic comments cannot be placed arbitrary, but should rather enclose independent top-level definitions. ## Current limitations * CPP support is experimental. CPP is virtually impossible to handle correctly, so we process them as a sort of unchangeable snippets. This works only in simple cases when CPP conditionals surround top-level declarations. See the [CPP][design-cpp] section in the design notes for a discussion of the dangers. * Input modules should be parsable by Haddock, which is a bit stricter criterion than just being valid Haskell modules. * Various minor idempotence issues, most of them are related to comments. ## Editor integration We know of the following editor integrations: * [Emacs][emacs-package] * [VS Code][vs-code-plugin] * vim: [neoformat][neoformat], [vim-ormolu][vim-ormolu] ## Running on Hackage It's possible to try Ormolu on arbitrary packages from Hackage. For that execute (from the root of the cloned repo): ```console $ nix-build -A hackage. ``` Then inspect `result/log.txt` for possible problems. The derivation will also contain formatted `.hs` files for inspection and original inputs with `.hs-original` extension (those are with CPP dropped, exactly what is fed into Ormolu). ## Contributing See [CONTRIBUTING.md][contributing]. ## License See [LICENSE.md][license]. Copyright © 2018–present Tweag I/O [design-cpp]: https://github.com/tweag/ormolu/blob/master/DESIGN.md#cpp [contributing]: https://github.com/tweag/ormolu/blob/master/CONTRIBUTING.md [license]: https://github.com/tweag/ormolu/blob/master/LICENSE.md [haskell-src-exts]: https://hackage.haskell.org/package/haskell-src-exts [emacs-package]: https://github.com/vyorkin/ormolu.el [vs-code-plugin]: https://marketplace.visualstudio.com/items?itemName=sjurmillidahl.ormolu-vscode [vim-ormolu]: https://github.com/sdiehl/vim-ormolu [neoformat]: https://github.com/sbdchd/neoformat ormolu-0.1.2.0/Setup.hs0000644000000000000000000000012707346545000013012 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain ormolu-0.1.2.0/app/0000755000000000000000000000000007346545000012136 5ustar0000000000000000ormolu-0.1.2.0/app/Main.hs0000644000000000000000000001330707346545000013362 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} module Main (main) where import Control.Exception (SomeException, displayException, try) import Control.Monad import Data.Bool (bool) import Data.Either (lefts) import Data.List (intercalate, sort) import qualified Data.Text.IO as TIO import Data.Version (showVersion) import Development.GitRev import Options.Applicative import Ormolu import Ormolu.Parser (manualExts) import Ormolu.Utils (showOutputable) import Paths_ormolu (version) import System.Exit (ExitCode (..), exitWith) import System.IO (hPutStrLn, stderr) -- | Entry point of the program. main :: IO () main = withPrettyOrmoluExceptions $ do Opts {..} <- execParser optsParserInfo let formatOne' = formatOne optMode optConfig case optInputFiles of [] -> formatOne' Nothing ["-"] -> formatOne' Nothing [x] -> formatOne' (Just x) xs -> do -- It is possible to get IOException, error's and 'OrmoluException's -- from 'formatOne', so we just catch everything. errs <- lefts <$> mapM (try @SomeException . formatOne' . Just) (sort xs) unless (null errs) $ do mapM_ (hPutStrLn stderr . displayException) errs exitWith (ExitFailure 102) -- | Format a single input. formatOne :: -- | Mode of operation Mode -> -- | Configuration Config RegionIndices -> -- | File to format or stdin as 'Nothing' Maybe FilePath -> IO () formatOne mode config = \case Nothing -> do r <- ormoluStdin config case mode of Stdout -> TIO.putStr r _ -> do hPutStrLn stderr "This feature is not supported when input comes from stdin." -- 101 is different from all the other exit codes we already use. exitWith (ExitFailure 101) Just inputFile -> do r <- ormoluFile config inputFile case mode of Stdout -> TIO.putStr r InPlace -> TIO.writeFile inputFile r Check -> do r' <- TIO.readFile inputFile when (r /= r') $ -- 100 is different to all the other exit code that are emitted -- either from an 'OrmoluException' or from 'error' and -- 'notImplemented'. exitWith (ExitFailure 100) ---------------------------------------------------------------------------- -- Command line options parsing. data Opts = Opts { -- | Mode of operation optMode :: !Mode, -- | Ormolu 'Config' optConfig :: !(Config RegionIndices), -- | Haskell source files to format or stdin (when the list is empty) optInputFiles :: ![FilePath] } -- | Mode of operation. data Mode = -- | Output formatted source code to stdout Stdout | -- | Overwrite original file InPlace | -- | Exit with non-zero status code if -- source is not already formatted Check deriving (Eq, Show) optsParserInfo :: ParserInfo Opts optsParserInfo = info (helper <*> ver <*> exts <*> optsParser) . mconcat $ [ fullDesc, progDesc "", header "" ] where ver :: Parser (a -> a) ver = infoOption verStr . mconcat $ [ long "version", short 'v', help "Print version of the program" ] verStr = intercalate "\n" [ unwords [ "ormolu", showVersion version, $gitBranch, $gitHash ], "using ghc-lib-parser " ++ VERSION_ghc_lib_parser ] exts :: Parser (a -> a) exts = infoOption displayExts . mconcat $ [ long "manual-exts", help "Display extensions that need to be enabled manually" ] displayExts = unlines $ sort (showOutputable <$> manualExts) optsParser :: Parser Opts optsParser = Opts <$> ( (fmap (bool Stdout InPlace) . switch . mconcat) [ short 'i', help "A shortcut for --mode inplace" ] <|> (option parseMode . mconcat) [ long "mode", short 'm', metavar "MODE", value Stdout, help "Mode of operation: 'stdout' (default), 'inplace', or 'check'" ] ) <*> configParser <*> (many . strArgument . mconcat) [ metavar "FILE", help "Haskell source files to format or stdin (default)" ] configParser :: Parser (Config RegionIndices) configParser = Config <$> (fmap (fmap DynOption) . many . strOption . mconcat) [ long "ghc-opt", short 'o', metavar "OPT", help "GHC options to enable (e.g. language extensions)" ] <*> (switch . mconcat) [ long "unsafe", short 'u', help "Do formatting faster but without automatic detection of defects" ] <*> (switch . mconcat) [ long "debug", short 'd', help "Output information useful for debugging" ] <*> (switch . mconcat) [ long "check-idempotence", short 'c', help "Fail if formatting is not idempotent" ] <*> ( RegionIndices <$> (optional . option auto . mconcat) [ long "start-line", metavar "START", help "Start line of the region to format (starts from 1)" ] <*> (optional . option auto . mconcat) [ long "end-line", metavar "END", help "End line of the region to format (inclusive)" ] ) ---------------------------------------------------------------------------- -- Helpers -- | Parse 'Mode'. parseMode :: ReadM Mode parseMode = eitherReader $ \case "stdout" -> Right Stdout "inplace" -> Right InPlace "check" -> Right Check s -> Left $ "unknown mode: " ++ s ormolu-0.1.2.0/data/examples/declaration/annotation/0000755000000000000000000000000007346545000020544 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/annotation/annotation-out.hs0000644000000000000000000000034307346545000024057 0ustar0000000000000000{-# 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 -} ormolu-0.1.2.0/data/examples/declaration/annotation/annotation.hs0000644000000000000000000000041407346545000023251 0ustar0000000000000000{-#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 -} ormolu-0.1.2.0/data/examples/declaration/class/0000755000000000000000000000000007346545000017477 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/class/associated-data1-out.hs0000644000000000000000000000025307346545000023747 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} class Foo a where data FooBar a -- | Something. class Bar a where -- | Bar bar data BarBar a -- | Bar baz data BarBaz a ormolu-0.1.2.0/data/examples/declaration/class/associated-data1.hs0000644000000000000000000000027107346545000023142 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-data2-out.hs0000644000000000000000000000031407346545000023746 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-data2.hs0000644000000000000000000000033707346545000023146 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-type-defaults-out.hs0000644000000000000000000000050307346545000025541 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-type-defaults.hs0000644000000000000000000000046507346545000024743 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-types1-out.hs0000644000000000000000000000025307346545000024202 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} class Foo a where type FooBar a -- | Something. class Bar a where -- | Bar bar type BarBar a -- | Bar baz type BarBaz a ormolu-0.1.2.0/data/examples/declaration/class/associated-types1.hs0000644000000000000000000000026207346545000023375 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} class Foo a where type FooBar a -- | Something. class Bar a where -- | Bar bar type BarBar a -- | Bar baz type BarBaz a ormolu-0.1.2.0/data/examples/declaration/class/associated-types2-out.hs0000644000000000000000000000035407346545000024205 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/associated-types2.hs0000644000000000000000000000040707346545000023377 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/default-implementations-comments-out.hs0000644000000000000000000000045707346545000027323 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/default-implementations-comments.hs0000644000000000000000000000054307346545000026512 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/default-implementations-out.hs0000644000000000000000000000022007346545000025464 0ustar0000000000000000module Main where -- | Foo class Foo a where foo :: a -> a foo a = a -- | Bar class Bar a where bar :: a -> Int bar = const 0 ormolu-0.1.2.0/data/examples/declaration/class/default-implementations.hs0000644000000000000000000000024307346545000024664 0ustar0000000000000000module Main where -- | Foo class Foo a where foo :: a -> a foo a = a -- | Bar class Bar a where bar :: a -> Int bar = const 0 ormolu-0.1.2.0/data/examples/declaration/class/default-signatures-out.hs0000644000000000000000000000051107346545000024443 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/default-signatures-simple-out.hs0000644000000000000000000000021107346545000025727 0ustar0000000000000000module Main where -- | Something. class Foo a where -- | Foo foo :: a -> String default foo :: Show a => a -> String foo = show ormolu-0.1.2.0/data/examples/declaration/class/default-signatures-simple.hs0000644000000000000000000000022107346545000025123 0ustar0000000000000000module Main where -- | Something. class Foo a where -- | Foo foo :: a -> String default foo :: Show a => a -> String foo = show ormolu-0.1.2.0/data/examples/declaration/class/default-signatures.hs0000644000000000000000000000056407346545000023646 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/dependency-super-classes-out.hs0000644000000000000000000000067607346545000025556 0ustar0000000000000000{-# 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 () ormolu-0.1.2.0/data/examples/declaration/class/dependency-super-classes.hs0000644000000000000000000000075507346545000024747 0ustar0000000000000000module 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 () ormolu-0.1.2.0/data/examples/declaration/class/empty-classes-out.hs0000644000000000000000000000010007346545000023420 0ustar0000000000000000module Main where -- | Foo! class Foo a -- | Bar! class Bar a ormolu-0.1.2.0/data/examples/declaration/class/empty-classes.hs0000644000000000000000000000010507346545000022620 0ustar0000000000000000module Main where -- | Foo! class Foo a where -- | Bar! class Bar a ormolu-0.1.2.0/data/examples/declaration/class/functional-dependencies-out.hs0000644000000000000000000000051007346545000025422 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/functional-dependencies.hs0000644000000000000000000000050407346545000024620 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/multi-parameters1-out.hs0000644000000000000000000000031407346545000024212 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/multi-parameters1.hs0000644000000000000000000000035207346545000023407 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/multi-parameters2-out.hs0000644000000000000000000000035107346545000024214 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/class/multi-parameters2.hs0000644000000000000000000000052407346545000023411 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/newlines-after-where-out.hs0000644000000000000000000000011707346545000024672 0ustar0000000000000000class Num a where (+) :: a -> a -> a class Num a where (+) :: a -> a -> a ormolu-0.1.2.0/data/examples/declaration/class/newlines-after-where.hs0000644000000000000000000000012107346545000024060 0ustar0000000000000000class Num a where (+) :: a -> a -> a class Num a where (+) :: a -> a -> a ormolu-0.1.2.0/data/examples/declaration/class/newlines-and-default-decls-out.hs0000644000000000000000000000022107346545000025731 0ustar0000000000000000class Foo a where foo :: a default foo :: () foo = () bar :: a default bar :: () bar = () qux :: a default qux :: () qux = () ormolu-0.1.2.0/data/examples/declaration/class/newlines-and-default-decls.hs0000644000000000000000000000022307346545000025126 0ustar0000000000000000class Foo a where foo :: a default foo :: () foo = () bar :: a default bar :: () bar = () qux :: a default qux :: () qux = () ormolu-0.1.2.0/data/examples/declaration/class/newlines-and-haddocks-out.hs0000644000000000000000000000046607346545000025010 0ustar0000000000000000class Foo a where -- | Haddock foo :: a -- | Another Haddock bar :: a baz :: a -- ^ Post-Haddock raz :: a -- ^ Another Post-Haddock -- | One more Haddock qux :: a -- Comment before a Haddock -- | And one more Haddock xyz :: a -- | Haddock followed by a blank line abc :: a ormolu-0.1.2.0/data/examples/declaration/class/newlines-and-haddocks.hs0000644000000000000000000000046207346545000024177 0ustar0000000000000000class Foo a where -- | Haddock foo :: a -- | Another Haddock bar :: a baz :: a -- ^ Post-Haddock raz :: a -- ^ Another Post-Haddock -- | One more Haddock qux :: a -- Comment before a Haddock -- | And one more Haddock xyz :: a -- | Haddock followed by a blank line abc :: a ormolu-0.1.2.0/data/examples/declaration/class/newlines-between-methods-out.hs0000644000000000000000000000044107346545000025553 0ustar0000000000000000class Num a where (+) :: a -> a -> a (-) :: a -> a -> a (*) :: a -> a -> a -- Comment before definition negate :: a -> a -- Comment after definition -- Separator abs :: a -> a signum :: a -> a -- Comment between unrelated definitions fromInteger :: Integer -> a ormolu-0.1.2.0/data/examples/declaration/class/newlines-between-methods.hs0000644000000000000000000000043707346545000024753 0ustar0000000000000000class Num a where (+) :: a -> a -> a (-) :: a -> a -> a (*) :: a -> a -> a -- Comment before definition negate :: a -> a -- Comment after definition -- Separator abs :: a -> a signum :: a -> a -- Comment between unrelated definitions fromInteger :: Integer -> a ormolu-0.1.2.0/data/examples/declaration/class/poly-kinded-classes-out.hs0000644000000000000000000000015307346545000024511 0ustar0000000000000000{-# LANGUAGE PolyKinds #-} class Foo (a :: k) class Bar ( a :: -- Variable * -- Star ) ormolu-0.1.2.0/data/examples/declaration/class/poly-kinded-classes.hs0000644000000000000000000000014507346545000023705 0ustar0000000000000000{-# LANGUAGE PolyKinds #-} class Foo (a::k) class Bar (a -- Variable :: * -- Star ) ormolu-0.1.2.0/data/examples/declaration/class/single-parameters-out.hs0000644000000000000000000000053507346545000024265 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/single-parameters.hs0000644000000000000000000000055207346545000023457 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/class/super-classes-out.hs0000644000000000000000000000022507346545000023430 0ustar0000000000000000class 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 ormolu-0.1.2.0/data/examples/declaration/class/super-classes.hs0000644000000000000000000000023307346545000022622 0ustar0000000000000000class () => 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 ormolu-0.1.2.0/data/examples/declaration/class/type-operators1-out.hs0000644000000000000000000000033107346545000023713 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} class (:$) a b class (:&) a b class a :* b class a -- Before operator :+ b -- After operator class ( f :. g ) a ormolu-0.1.2.0/data/examples/declaration/class/type-operators1.hs0000644000000000000000000000033207346545000023107 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} class (:$) a b class (:&) a b class a:*b class a -- Before operator :+ b -- After operator class ( f :. g ) a ormolu-0.1.2.0/data/examples/declaration/class/type-operators2-out.hs0000644000000000000000000000025507346545000023721 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} class a `Pair` b class a `Sum` b class (f `Product` g) a class ( f `Sum` g ) a ormolu-0.1.2.0/data/examples/declaration/class/type-operators2.hs0000644000000000000000000000025507346545000023114 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TypeOperators #-} class a`Pair`b class a `Sum` b class (f`Product`g)a class ( f `Sum` g ) a ormolu-0.1.2.0/data/examples/declaration/class/type-operators3-out.hs0000644000000000000000000000032007346545000023713 0ustar0000000000000000{-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoStarIsType #-} class PNum x where type (a :: x) * (b :: x) instance PNum Nat where type a * b = () ormolu-0.1.2.0/data/examples/declaration/class/type-operators3.hs0000644000000000000000000000024007346545000023107 0ustar0000000000000000{-# LANGUAGE TypeFamilies, TypeOperators, NoStarIsType, PolyKinds #-} class PNum x where type (a :: x) * (b :: x) instance PNum Nat where type a * b = () ormolu-0.1.2.0/data/examples/declaration/data/0000755000000000000000000000000007346545000017303 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/data/deriving-out.hs0000644000000000000000000000007607346545000022256 0ustar0000000000000000newtype R r a = R (ReaderT r IO a) deriving (MonadReader r) ormolu-0.1.2.0/data/examples/declaration/data/deriving-strategies-out.hs0000644000000000000000000000037507346545000024430 0ustar0000000000000000module 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) ormolu-0.1.2.0/data/examples/declaration/data/deriving-strategies.hs0000644000000000000000000000036507346545000023622 0ustar0000000000000000module 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) ormolu-0.1.2.0/data/examples/declaration/data/deriving.hs0000644000000000000000000000007607346545000021451 0ustar0000000000000000newtype R r a = R (ReaderT r IO a) deriving (MonadReader r) ormolu-0.1.2.0/data/examples/declaration/data/empty-out.hs0000644000000000000000000000005207346545000021577 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls #-} data Foo ormolu-0.1.2.0/data/examples/declaration/data/empty.hs0000644000000000000000000000005207346545000020772 0ustar0000000000000000{-# LANGUAGE EmptyDataDecls #-} data Foo ormolu-0.1.2.0/data/examples/declaration/data/existential-multiline-out.hs0000644000000000000000000000034107346545000024773 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} data Foo = forall a. MkFoo a (a -> Bool) | forall a. Eq a => MkBar a data Bar = forall x y. Bar x y x y data Baz = forall x y. Baz x y x y ormolu-0.1.2.0/data/examples/declaration/data/existential-multiline.hs0000644000000000000000000000033407346545000024170 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} data Foo = forall a. MkFoo a (a -> Bool) | forall a. Eq a => MkBar a data Bar = forall x y. Bar x y x y data Baz = forall x y. Baz x y x y ormolu-0.1.2.0/data/examples/declaration/data/existential-out.hs0000644000000000000000000000017607346545000023001 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} data Foo = forall a. MkFoo a (a -> Bool) data Bar = forall a b. a + b => Bar a b ormolu-0.1.2.0/data/examples/declaration/data/existential.hs0000644000000000000000000000017607346545000022174 0ustar0000000000000000{-# LANGUAGE ExistentialQuantification #-} data Foo = forall a. MkFoo a (a -> Bool) data Bar = forall a b. a + b => Bar a b ormolu-0.1.2.0/data/examples/declaration/data/fat-multiline-out.hs0000644000000000000000000000020007346545000023206 0ustar0000000000000000module Main where -- | Something. data Foo = -- | Foo Foo Int Int | -- | Bar Bar Bool Bool ormolu-0.1.2.0/data/examples/declaration/data/fat-multiline.hs0000644000000000000000000000017107346545000022410 0ustar0000000000000000module Main where -- | Something. data Foo = Foo Int Int -- ^ Foo | Bar Bool Bool -- ^ Bar ormolu-0.1.2.0/data/examples/declaration/data/gadt-syntax-out.hs0000644000000000000000000000011507346545000022704 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} data Foo where MKFoo :: a -> (a -> Bool) -> Foo ormolu-0.1.2.0/data/examples/declaration/data/gadt-syntax.hs0000644000000000000000000000011707346545000022101 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} data Foo where { MKFoo :: a -> (a->Bool) -> Foo } ormolu-0.1.2.0/data/examples/declaration/data/gadt/0000755000000000000000000000000007346545000020222 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiline-out.hs0000644000000000000000000000063307346545000023367 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiline-where-out.hs0000644000000000000000000000010707346545000024473 0ustar0000000000000000data Foo a b c where Foo :: a -> b -> c -> Foo a b c ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiline-where.hs0000644000000000000000000000010507346545000023664 0ustar0000000000000000data Foo a b c where Foo :: a -> b -> c -> Foo a b c ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiline.hs0000644000000000000000000000057407346545000022566 0ustar0000000000000000module 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 ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiple-declaration-out.hs0000644000000000000000000000031007346545000025473 0ustar0000000000000000data 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 ormolu-0.1.2.0/data/examples/declaration/data/gadt/multiple-declaration.hs0000644000000000000000000000027307346545000024676 0ustar0000000000000000data 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 ormolu-0.1.2.0/data/examples/declaration/data/gadt/record-out.hs0000644000000000000000000000032307346545000022637 0ustar0000000000000000module Main where -- | Something. data Foo where Foo :: {fooX :: Int} -> Foo Bar :: { fooY :: Int, fooBar, fooBaz :: Bool, fooFoo, barBar, bazBaz :: Int } -> Foo ormolu-0.1.2.0/data/examples/declaration/data/gadt/record.hs0000644000000000000000000000034307346545000022034 0ustar0000000000000000module Main where -- | Something. data Foo where Foo :: { fooX :: Int } -> Foo Bar :: { fooY :: Int , fooBar, fooBaz :: Bool , fooFoo , barBar , bazBaz :: Int } -> Foo ormolu-0.1.2.0/data/examples/declaration/data/gadt/simple-out.hs0000644000000000000000000000052007346545000022651 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/data/gadt/simple.hs0000644000000000000000000000046107346545000022050 0ustar0000000000000000module 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'. ormolu-0.1.2.0/data/examples/declaration/data/gadt/strictness-out.hs0000644000000000000000000000017107346545000023563 0ustar0000000000000000data Foo a where Foo1 :: !Int -> {-# UNPACK #-} !Bool -> Foo Int Foo2 :: {-# UNPACK #-} Maybe Int && Bool -> Foo Int ormolu-0.1.2.0/data/examples/declaration/data/gadt/strictness.hs0000644000000000000000000000017107346545000022756 0ustar0000000000000000data Foo a where Foo1 :: !Int -> {-# UNPACK #-} !Bool -> Foo Int Foo2 :: {-# UNPACK #-} Maybe Int && Bool -> Foo Int ormolu-0.1.2.0/data/examples/declaration/data/infix-out.hs0000644000000000000000000000003107346545000021553 0ustar0000000000000000data Foo a b = a `Foo` b ormolu-0.1.2.0/data/examples/declaration/data/infix.hs0000644000000000000000000000003107346545000020746 0ustar0000000000000000data Foo a b = a `Foo` b ormolu-0.1.2.0/data/examples/declaration/data/kind-annotations-out.hs0000644000000000000000000000041707346545000023726 0ustar0000000000000000data Something (n :: Nat) = Something data Format (k :: *) (k' :: *) (k'' :: *) type Parens1 = Proxy '(a :: A, b :: (B :: *)) type Parens2 = Proxy '((a :: A), (b :: B)) type family Foo a where Foo '(a :: Int, b :: Bool) = Int Foo '((a :: Int), (b :: Bool)) = Int ormolu-0.1.2.0/data/examples/declaration/data/kind-annotations.hs0000644000000000000000000000041607346545000023120 0ustar0000000000000000data Something (n :: Nat) = Something data Format (k :: *) (k' :: *) (k'' :: *) type Parens1 = Proxy '(a :: A, b :: (B :: *)) type Parens2 = Proxy '((a :: A), (b :: B)) type family Foo a where Foo '(a :: Int, b :: Bool) = Int Foo '((a :: Int), (b :: Bool)) = Int ormolu-0.1.2.0/data/examples/declaration/data/multiline-arg-parens-out.hs0000644000000000000000000000022207346545000024477 0ustar0000000000000000module Main where -- | Something. data Foo = Foo Bar (Set Baz) -- and here we go -- and that's it Text deriving (Eq) ormolu-0.1.2.0/data/examples/declaration/data/multiline-arg-parens.hs0000644000000000000000000000023507346545000023676 0ustar0000000000000000module Main where -- | Something. data Foo = Foo Bar (Set Baz) -- and here we go -- and that's it Text deriving (Eq) ormolu-0.1.2.0/data/examples/declaration/data/multiline-names-out.hs0000644000000000000000000000044707346545000023554 0ustar0000000000000000data 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) ormolu-0.1.2.0/data/examples/declaration/data/multiline-names.hs0000644000000000000000000000044207346545000022742 0ustar0000000000000000data 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) ormolu-0.1.2.0/data/examples/declaration/data/multiline-out.hs0000644000000000000000000000022407346545000022444 0ustar0000000000000000module Main where -- | Here we have 'Foo'. data Foo = -- | One Foo | -- | Two Bar Int | -- | Three Baz deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/multiline.hs0000644000000000000000000000021107346545000021633 0ustar0000000000000000module Main where -- | Here we have 'Foo'. data Foo = Foo -- ^ One | Bar Int -- ^ Two | Baz -- ^ Three deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/newtype-out.hs0000644000000000000000000000011707346545000022136 0ustar0000000000000000module Main where -- | Something. newtype Foo = Foo Int deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/newtype.hs0000644000000000000000000000012007346545000021323 0ustar0000000000000000module Main where -- | Something. newtype Foo = Foo Int deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/operators-out.hs0000644000000000000000000000057407346545000022470 0ustar0000000000000000data ErrorMessage' s = -- | Show the text as is. Text s | -- | Pretty print the type. -- @ShowType :: k -> ErrorMessage@ forall t. ShowType t | -- | Put two pieces of error message next -- to each other. ErrorMessage' s :<>: ErrorMessage' s | -- | Stack two pieces of error message on top -- of each other. ErrorMessage' s :$$: ErrorMessage' s ormolu-0.1.2.0/data/examples/declaration/data/operators.hs0000644000000000000000000000057407346545000021663 0ustar0000000000000000data ErrorMessage' s = -- | Show the text as is. Text s | -- | Pretty print the type. -- @ShowType :: k -> ErrorMessage@ forall t. ShowType t | -- | Put two pieces of error message next -- to each other. ErrorMessage' s :<>: ErrorMessage' s | -- | Stack two pieces of error message on top -- of each other. ErrorMessage' s :$$: ErrorMessage' s ormolu-0.1.2.0/data/examples/declaration/data/partly-documented-out.hs0000644000000000000000000000021007346545000024075 0ustar0000000000000000data Optimisation = PETransform | -- | partial eval and associated transforms GeneralisedNatHack deriving (Show, Eq, Generic) ormolu-0.1.2.0/data/examples/declaration/data/partly-documented.hs0000644000000000000000000000020007346545000023267 0ustar0000000000000000data Optimisation = PETransform | GeneralisedNatHack -- ^ partial eval and associated transforms deriving (Show, Eq, Generic) ormolu-0.1.2.0/data/examples/declaration/data/record-multi-const-out.hs0000644000000000000000000000036007346545000024175 0ustar0000000000000000module Main where -- | Something. data Foo = Foo { -- | X fooX :: Int, -- | Y fooY :: Int } | Bar { -- | X barX :: Int, -- | Y barY :: Int } deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/record-multi-const.hs0000644000000000000000000000026507346545000023374 0ustar0000000000000000module Main where -- | Something. data Foo = Foo { fooX :: Int -- ^ X , fooY :: Int -- ^ Y } | Bar { barX :: Int -- ^ X , barY :: Int -- ^ Y } deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/record-out.hs0000644000000000000000000000053707346545000021727 0ustar0000000000000000module 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) ormolu-0.1.2.0/data/examples/declaration/data/record-singleline-out.hs0000644000000000000000000000014307346545000024047 0ustar0000000000000000module Main where -- | Something. data Foo = Foo {fooX :: Int, fooY :: Int} deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/record-singleline.hs0000644000000000000000000000014707346545000023246 0ustar0000000000000000module Main where -- | Something. data Foo = Foo { fooX :: Int , fooY :: Int } deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/record.hs0000644000000000000000000000050107346545000021111 0ustar0000000000000000module 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) ormolu-0.1.2.0/data/examples/declaration/data/simple-broken-out.hs0000644000000000000000000000022607346545000023213 0ustar0000000000000000module Main where -- | Here we go. data Foo = Foo {unFoo :: Int} deriving (Eq) -- | And once again. data Bar = Bar {unBar :: Int} deriving (Eq) ormolu-0.1.2.0/data/examples/declaration/data/simple-broken.hs0000644000000000000000000000023607346545000022407 0ustar0000000000000000module Main where -- | Here we go. data Foo = Foo { unFoo :: Int } deriving (Eq) -- | And once again. data Bar = Bar { unBar :: Int } deriving (Eq) ormolu-0.1.2.0/data/examples/declaration/data/simple-out.hs0000644000000000000000000000014507346545000021735 0ustar0000000000000000module Main where -- | And here we have 'Foo'. data Foo = Foo | Bar Int | Baz deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/simple.hs0000644000000000000000000000014607346545000021131 0ustar0000000000000000module Main where -- | And here we have 'Foo'. data Foo = Foo | Bar Int | Baz deriving (Eq, Show) ormolu-0.1.2.0/data/examples/declaration/data/strictness-out.hs0000644000000000000000000000023107346545000022641 0ustar0000000000000000module Main where -- | Something. data Foo = Foo1 !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String | Foo2 {a :: {-# UNPACK #-} Maybe Int && Bool} ormolu-0.1.2.0/data/examples/declaration/data/strictness.hs0000644000000000000000000000023407346545000022037 0ustar0000000000000000module Main where -- | Something. data Foo = Foo1 !Int {-# UNPACK #-} !Bool {-# NOUNPACK #-} !String | Foo2 { a :: {-# UNPACK #-} Maybe Int && Bool } ormolu-0.1.2.0/data/examples/declaration/data/unnamed-field-comment-0-out.hs0000644000000000000000000000013607346545000024751 0ustar0000000000000000data Foo = -- | Bar Bar Field1 -- ^ Field 1 Field2 -- ^ Field 2 ormolu-0.1.2.0/data/examples/declaration/data/unnamed-field-comment-0.hs0000644000000000000000000000012207346545000024137 0ustar0000000000000000data Foo = -- | Bar Bar Field1 -- ^ Field 1 Field2 -- ^ Field 2 ormolu-0.1.2.0/data/examples/declaration/data/unnamed-field-comment-1-out.hs0000644000000000000000000000005507346545000024752 0ustar0000000000000000data X = B !Int -- ^ y C ormolu-0.1.2.0/data/examples/declaration/data/unnamed-field-comment-1.hs0000644000000000000000000000004507346545000024144 0ustar0000000000000000data X = B !Int -- ^ y C ormolu-0.1.2.0/data/examples/declaration/data/with-comment-out.hs0000644000000000000000000000004107346545000023052 0ustar0000000000000000data A = B -- C | -- D E ormolu-0.1.2.0/data/examples/declaration/data/with-comment.hs0000644000000000000000000000004607346545000022252 0ustar0000000000000000data A = B -- C -- D | E ormolu-0.1.2.0/data/examples/declaration/data/with-weird-haddock-out.hs0000644000000000000000000000013607346545000024122 0ustar0000000000000000data PlusLevel' t = -- | @n + ℓ@. Plus Integer (LevelAtom' t) deriving (Show, Data) ormolu-0.1.2.0/data/examples/declaration/data/with-weird-haddock.hs0000644000000000000000000000013107346545000023310 0ustar0000000000000000data PlusLevel' t = Plus Integer (LevelAtom' t) -- ^ @n + ℓ@. deriving (Show, Data) ormolu-0.1.2.0/data/examples/declaration/default/0000755000000000000000000000000007346545000020016 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/default/default-out.hs0000644000000000000000000000007707346545000022607 0ustar0000000000000000default (Int, Foo, Bar) default ( Int, Foo, Bar ) ormolu-0.1.2.0/data/examples/declaration/default/default.hs0000644000000000000000000000014507346545000021776 0ustar0000000000000000default ( Int , Foo , Bar ) default ( Int , Foo, Bar ) ormolu-0.1.2.0/data/examples/declaration/deriving/0000755000000000000000000000000007346545000020201 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/deriving/multiline-out.hs0000644000000000000000000000035007346545000023342 0ustar0000000000000000deriving 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 ormolu-0.1.2.0/data/examples/declaration/deriving/multiline.hs0000644000000000000000000000041607346545000022540 0ustar0000000000000000deriving 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 ormolu-0.1.2.0/data/examples/declaration/deriving/overlapping-out.hs0000644000000000000000000000033207346545000023666 0ustar0000000000000000deriving instance {-# OVERLAPPABLE #-} Ord Foo deriving instance {-# OVERLAPPING #-} Num Foo deriving instance {-# OVERLAPS #-} Read Foo deriving instance {-# INCOHERENT #-} Show Foo ormolu-0.1.2.0/data/examples/declaration/deriving/overlapping.hs0000644000000000000000000000035007346545000023061 0ustar0000000000000000deriving instance {-# OVERLAPPABLE #-} Ord Foo deriving instance {-# OVERLAPPING #-} Num Foo deriving instance {-# OVERLAPS #-} Read Foo deriving instance {-# INCOHERENT #-} Show Foo ormolu-0.1.2.0/data/examples/declaration/deriving/singleline-out.hs0000644000000000000000000000055107346545000023474 0ustar0000000000000000deriving 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 ormolu-0.1.2.0/data/examples/declaration/deriving/singleline.hs0000644000000000000000000000054407346545000022671 0ustar0000000000000000deriving 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 ormolu-0.1.2.0/data/examples/declaration/foreign/0000755000000000000000000000000007346545000020023 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/foreign/foreign-export-out.hs0000644000000000000000000000047107346545000024136 0ustar0000000000000000foreign 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 ()) ormolu-0.1.2.0/data/examples/declaration/foreign/foreign-export.hs0000644000000000000000000000046607346545000023335 0ustar0000000000000000foreign 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 ()) ormolu-0.1.2.0/data/examples/declaration/foreign/foreign-import-out.hs0000644000000000000000000000122607346545000024126 0ustar0000000000000000{-# 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 () ormolu-0.1.2.0/data/examples/declaration/foreign/foreign-import.hs0000644000000000000000000000121207346545000023314 0ustar0000000000000000{-# 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 () ormolu-0.1.2.0/data/examples/declaration/instance/0000755000000000000000000000000007346545000020176 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/instance/associated-data-out.hs0000644000000000000000000000042607346545000024367 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/instance/associated-data.hs0000644000000000000000000000051307346545000023557 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/instance/associated-types-out.hs0000644000000000000000000000027407346545000024623 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} instance Foo Int where type Bar Int = Double instance Foo Double where type Bar Double = [Double] type Baz Double = [Double] ormolu-0.1.2.0/data/examples/declaration/instance/associated-types.hs0000644000000000000000000000033107346545000024010 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} instance Foo Int where type Bar Int = Double instance Foo Double where type Bar Double = [Double] type instance Baz Double = [Double] ormolu-0.1.2.0/data/examples/declaration/instance/contexts-comments-out.hs0000644000000000000000000000030707346545000025031 0ustar0000000000000000instance ( Read a, -- Foo Read b, Read ( c, -- Bar d ) ) => Read ( a, -- Baz b, ( c, -- Quux d ) ) where readsPrec = undefined ormolu-0.1.2.0/data/examples/declaration/instance/contexts-comments.hs0000644000000000000000000000027007346545000024223 0ustar0000000000000000instance ( Read a, -- Foo Read b , Read ( c, -- Bar d ) ) => Read ( a, -- Baz b ,( c, -- Quux d ) ) where readsPrec = undefined ormolu-0.1.2.0/data/examples/declaration/instance/contexts-out.hs0000644000000000000000000000034307346545000023206 0ustar0000000000000000instance 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 "" ormolu-0.1.2.0/data/examples/declaration/instance/contexts.hs0000644000000000000000000000032607346545000022402 0ustar0000000000000000instance 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 "" ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances-gadt-out.hs0000644000000000000000000000030707346545000026431 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} {-# LANGUAGE TypeFamilies #-} data instance Bar Int a where SameBar :: Bar Int Int CloseBar :: Bar Int Double OtherBar :: Bar Int a ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances-gadt.hs0000644000000000000000000000031607346545000025624 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} {-# LANGUAGE TypeFamilies #-} data instance Bar Int a where SameBar :: Bar Int Int CloseBar :: Bar Int Double OtherBar :: Bar Int a ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances-newtype-out.hs0000644000000000000000000000021307346545000027201 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} {-# LANGUAGE TypeFamilies #-} newtype instance Foo [Double] = DoubleListFoo { unDoubleListFoo :: Double } ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances-newtype.hs0000644000000000000000000000021307346545000026374 0ustar0000000000000000{-# LANGUAGE GADTSyntax #-} {-# LANGUAGE TypeFamilies #-} newtype instance Foo [Double] = DoubleListFoo { unDoubleListFoo :: Double } ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances-out.hs0000644000000000000000000000043107346545000025512 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/instance/data-family-instances.hs0000644000000000000000000000045407346545000024712 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/instance/empty-instance-out.hs0000644000000000000000000000005407346545000024276 0ustar0000000000000000instance Typeable Int instance Generic Int ormolu-0.1.2.0/data/examples/declaration/instance/empty-instance.hs0000644000000000000000000000006107346545000023467 0ustar0000000000000000instance Typeable Int instance Generic Int where ormolu-0.1.2.0/data/examples/declaration/instance/instance-sigs-multiple-out.hs0000644000000000000000000000023107346545000025733 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} instance Applicative [] where pure :: a -> [a] pure a = [a] (<*>) :: [a] -> [a] -> [a] (<*>) _ _ = [] ormolu-0.1.2.0/data/examples/declaration/instance/instance-sigs-multiple.hs0000644000000000000000000000024207346545000025130 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} instance Applicative [] where pure :: a -> [a] pure a = [a] (<*>) :: [ a ] -> [ a ] -> [ a ] (<*>) _ _ = [] ormolu-0.1.2.0/data/examples/declaration/instance/instance-sigs-out.hs0000644000000000000000000000031607346545000024106 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} instance Eq Int where (==) :: Int -> Int -> Bool (==) _ _ = False instance Ord Int where compare :: Int -> Int -> Ordering compare _ _ = GT ormolu-0.1.2.0/data/examples/declaration/instance/instance-sigs.hs0000644000000000000000000000036107346545000023301 0ustar0000000000000000{-# LANGUAGE InstanceSigs #-} instance Eq Int where (==) :: Int -> Int -> Bool (==) _ _ = False instance Ord Int where compare :: Int -> Int -> Ordering compare _ _ = GT ormolu-0.1.2.0/data/examples/declaration/instance/multi-parameter-out.hs0000644000000000000000000000017207346545000024447 0ustar0000000000000000instance MonadReader a ((->) a) where ask = id instance MonadState s (State s) where get = State.get put = State.put ormolu-0.1.2.0/data/examples/declaration/instance/multi-parameter.hs0000644000000000000000000000020207346545000023634 0ustar0000000000000000instance MonadReader a ((->) a) where ask = id instance MonadState s (State s) where get = State.get put = State.put ormolu-0.1.2.0/data/examples/declaration/instance/newlines-after-where-out.hs0000644000000000000000000000011707346545000025371 0ustar0000000000000000instance Num X where (+) = undefined instance Num Y where (+) = undefined ormolu-0.1.2.0/data/examples/declaration/instance/newlines-after-where.hs0000644000000000000000000000012107346545000024557 0ustar0000000000000000instance Num X where (+) = undefined instance Num Y where (+) = undefined ormolu-0.1.2.0/data/examples/declaration/instance/newlines-between-methods-out.hs0000644000000000000000000000075507346545000026262 0ustar0000000000000000instance Num a => Num (Diff a) where D u dudx + D v dvdx = D (u + v) (dudx + dvdx) D u dudx - D v dvdx = D (u - v) (dudx - dvdx) D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx) -- Comment before definition negate (D u dudx) = D (- u) (- dudx) negate (Z u dudx) = undefined -- Comment after definition -- Separator abs (D u _) = D (abs u) (signum u) signum (D u _) = D (signum u) 0 -- Comment between unrelated definitions fromInteger n = D (fromInteger n) 0 ormolu-0.1.2.0/data/examples/declaration/instance/newlines-between-methods.hs0000644000000000000000000000075107346545000025451 0ustar0000000000000000instance Num a => Num (Diff a) where D u dudx + D v dvdx = D (u + v) (dudx + dvdx) D u dudx - D v dvdx = D (u - v) (dudx - dvdx) D u dudx * D v dvdx = D (u * v) (u * dvdx + v * dudx) -- Comment before definition negate (D u dudx) = D (-u) (-dudx) negate (Z u dudx) = undefined -- Comment after definition -- Separator abs (D u _) = D (abs u) (signum u) signum (D u _) = D (signum u) 0 -- Comment between unrelated definitions fromInteger n = D (fromInteger n) 0 ormolu-0.1.2.0/data/examples/declaration/instance/overlappable-instances-out.hs0000644000000000000000000000040407346545000025776 0ustar0000000000000000instance {-# 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 ormolu-0.1.2.0/data/examples/declaration/instance/overlappable-instances.hs0000644000000000000000000000042307346545000025172 0ustar0000000000000000instance {-# 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 ormolu-0.1.2.0/data/examples/declaration/instance/single-parameter-out.hs0000644000000000000000000000023707346545000024600 0ustar0000000000000000instance 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 ormolu-0.1.2.0/data/examples/declaration/instance/single-parameter.hs0000644000000000000000000000025307346545000023771 0ustar0000000000000000instance 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 } ormolu-0.1.2.0/data/examples/declaration/instance/type-family-instances-out.hs0000644000000000000000000000037707346545000025573 0ustar0000000000000000{-# 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 ) ormolu-0.1.2.0/data/examples/declaration/instance/type-family-instances.hs0000644000000000000000000000041207346545000024754 0ustar0000000000000000{-# 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 ) ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/0000755000000000000000000000000007346545000021020 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/basic1-out.hs0000644000000000000000000000032207346545000023320 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/basic1.hs0000644000000000000000000000030607346545000022515 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/basic2-out.hs0000644000000000000000000000064207346545000023326 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/basic2.hs0000644000000000000000000000065607346545000022526 0ustar0000000000000000{-# 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; #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/empty-out.hs0000644000000000000000000000002107346545000023310 0ustar0000000000000000{-# RULES #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/empty.hs0000644000000000000000000000002307346545000022505 0ustar0000000000000000{-# RULES #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/forall-0-out.hs0000644000000000000000000000022307346545000023572 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/forall-0.hs0000644000000000000000000000022007346545000022762 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/forall-1-out.hs0000644000000000000000000000061207346545000023575 0ustar0000000000000000{-# RULES "rd_tyvs" forall a. forall (x :: a). id x = x #-} {-# RULES "rd_tyvs'" forall f a. forall (x :: f a). id x = x #-} {-# RULES "rd_tyvs''" forall (a :: *). forall (x :: a). id x = x #-} {-# RULES "rd_tyvs_multiline1" forall (a :: *). forall (x :: a). id x = x #-} {-# RULES "rd_tyvs_multiline2" forall ( a :: * ). forall ( x :: a ). id x = x #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/forall-1.hs0000644000000000000000000000060607346545000022773 0ustar0000000000000000{-# RULES "rd_tyvs" forall a. forall (x :: a). id x = x #-} {-# RULES "rd_tyvs'" forall f a. forall (x :: f a). id x = x #-} {-# RULES "rd_tyvs''" forall (a :: *). forall (x :: a). id x = x #-} {-# RULES "rd_tyvs_multiline1" forall (a :: *). forall (x :: a). id x = x #-} {-# RULES "rd_tyvs_multiline2" forall (a :: *). forall (x :: a). id x = x #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/phase-out.hs0000644000000000000000000000043107346545000023257 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/phase.hs0000644000000000000000000000040007346545000022446 0ustar0000000000000000{-# 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 #-}ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude1-out.hs0000644000000000000000000000074107346545000023704 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude1.hs0000644000000000000000000000102307346545000023071 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude2-out.hs0000644000000000000000000000221707346545000023705 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude2.hs0000644000000000000000000000237207346545000023102 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude3-out.hs0000644000000000000000000000054707346545000023712 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude3.hs0000644000000000000000000000054707346545000023105 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude4-out.hs0000644000000000000000000000060107346545000023702 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/prelude4.hs0000644000000000000000000000063507346545000023104 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/type-signature-out.hs0000644000000000000000000000040507346545000025140 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/rewrite-rule/type-signature.hs0000644000000000000000000000041707346545000024336 0ustar0000000000000000{-# 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 #-} ormolu-0.1.2.0/data/examples/declaration/role-annotation/0000755000000000000000000000000007346545000021503 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/role-annotation/multi-line-out.hs0000644000000000000000000000016407346545000024724 0ustar0000000000000000type role D phantom nominal type role E _ nominal type role E _ nominal phantom ormolu-0.1.2.0/data/examples/declaration/role-annotation/multi-line.hs0000644000000000000000000000020007346545000024106 0ustar0000000000000000type role D phantom nominal type role E _ nominal type role E _ nominal phantom ormolu-0.1.2.0/data/examples/declaration/role-annotation/single-line-out.hs0000644000000000000000000000024107346545000025047 0ustar0000000000000000{-# LANGUAGE MagicHash #-} {-# LANGUAGE RoleAnnotations #-} type role Ptr representational type role A nominal nominal type role B _ phantom type role C _ _ ormolu-0.1.2.0/data/examples/declaration/role-annotation/single-line.hs0000644000000000000000000000024007346545000024241 0ustar0000000000000000{-# LANGUAGE RoleAnnotations #-} {-# LANGUAGE MagicHash #-} type role Ptr representational type role A nominal nominal type role B _ phantom type role C _ _ ormolu-0.1.2.0/data/examples/declaration/signature/complete/0000755000000000000000000000000007346545000022203 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/complete/complete-out.hs0000644000000000000000000000014407346545000025153 0ustar0000000000000000{-# COMPLETE A, B, C :: Foo #-} {-# COMPLETE A, B #-} {-# COMPLETE A, B, C :: Foo #-} ormolu-0.1.2.0/data/examples/declaration/signature/complete/complete.hs0000644000000000000000000000023007346545000024342 0ustar0000000000000000{-# ComPlETe A , B, C:: Foo #-} {-# COMPLETE A , B #-} {-# ComPlETE A , B, C :: Foo#-} ormolu-0.1.2.0/data/examples/declaration/signature/fixity/0000755000000000000000000000000007346545000021707 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infix-out.hs0000644000000000000000000000003307346545000024161 0ustar0000000000000000infix 0 infix 9 <^-^> ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infix.hs0000644000000000000000000000003207346545000023353 0ustar0000000000000000infix 0 infix 9 <^-^> ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infixl-out.hs0000644000000000000000000000004707346545000024342 0ustar0000000000000000infixl 8 *** infixl 0 $, *, +, &&, ** ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infixl.hs0000644000000000000000000000004607346545000023534 0ustar0000000000000000infixl 8 *** infixl 0 $, *, +, &&, ** ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infixr-out.hs0000644000000000000000000000004207346545000024343 0ustar0000000000000000infixr 8 `Foo` infixr 0 ***, &&& ormolu-0.1.2.0/data/examples/declaration/signature/fixity/infixr.hs0000644000000000000000000000004107346545000023535 0ustar0000000000000000infixr 8 `Foo` infixr 0 ***, &&& ormolu-0.1.2.0/data/examples/declaration/signature/inline/0000755000000000000000000000000007346545000021651 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/inline/conlike-out.hs0000644000000000000000000000013507346545000024435 0ustar0000000000000000foo :: Int foo = 5 {-# INLINE CONLIKE foo #-} bar :: Int bar = 6 {-# INLINE CONLIKE bar #-} ormolu-0.1.2.0/data/examples/declaration/signature/inline/conlike.hs0000644000000000000000000000013507346545000023630 0ustar0000000000000000foo :: Int foo = 5 {-# INLINE CONLIKE foo #-} bar :: Int bar = 6 {-# INLINE CONLIKE bar #-} ormolu-0.1.2.0/data/examples/declaration/signature/inline/inline-out.hs0000644000000000000000000000035107346545000024267 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/signature/inline/inline.hs0000644000000000000000000000036507346545000023467 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/signature/inline/inlineable-out.hs0000644000000000000000000000024107346545000025111 0ustar0000000000000000foo :: Int -> Int foo = id {-# INLINEABLE foo #-} {-# INLINEABLE [2] bar #-} bar :: Int -> Int bar = id baz :: Int -> Int baz = id {-# INLINEABLE [~2] baz #-} ormolu-0.1.2.0/data/examples/declaration/signature/inline/inlineable.hs0000644000000000000000000000025407346545000024310 0ustar0000000000000000foo :: Int -> Int foo = id {-# INLINEABLE foo #-} {-# INLINEABLE [2] bar #-} bar :: Int -> Int bar = id baz :: Int -> Int baz = id {-# INLINEABLE [~2] baz #-} ormolu-0.1.2.0/data/examples/declaration/signature/inline/noinline-out.hs0000644000000000000000000000023307346545000024623 0ustar0000000000000000foo :: Int -> Int foo = id {-# NOINLINE foo #-} {-# NOINLINE [2] bar #-} bar :: Int -> Int bar = id baz :: Int -> Int baz = id {-# NOINLINE [~2] baz #-} ormolu-0.1.2.0/data/examples/declaration/signature/inline/noinline.hs0000644000000000000000000000024507346545000024021 0ustar0000000000000000foo :: Int -> Int foo = id {-# NOINLINE foo #-} {-# NOINLINE [2] bar #-} bar :: Int -> Int bar = id baz :: Int -> Int baz = id {-# NOINLINE [~2] baz #-} ormolu-0.1.2.0/data/examples/declaration/signature/minimal/0000755000000000000000000000000007346545000022021 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/minimal/minimal-out.hs0000644000000000000000000000030207346545000024603 0ustar0000000000000000class Foo a where {-# MINIMAL (==) | ((/=), foo) #-} {-# MINIMAL a | ( b, c, d | e, f ) | g #-} (==) :: a -> a -> Bool (/=) :: a -> a -> Bool ormolu-0.1.2.0/data/examples/declaration/signature/minimal/minimal.hs0000644000000000000000000000027407346545000024006 0ustar0000000000000000class Foo a where {-# MINIMAL (==) |( (/=) , foo) #-} {-# MINIMAL a | (b , c , d | e , f) | g #-} (==) :: a -> a -> Bool (/=) :: a -> a -> Bool ormolu-0.1.2.0/data/examples/declaration/signature/pattern/0000755000000000000000000000000007346545000022050 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/pattern/multiline-out.hs0000644000000000000000000000036307346545000025215 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} pattern Arrow :: Type -> Type -> Type pattern Foo, Bar :: Type -> Type -> Type pattern TypeSignature, FunctionBody, PatternSignature, WarningPragma :: [RdrName] -> HsDecl GhcPs ormolu-0.1.2.0/data/examples/declaration/signature/pattern/multiline.hs0000644000000000000000000000036607346545000024413 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} pattern Arrow :: Type -> Type -> Type pattern Foo, Bar :: Type -> Type -> Type pattern TypeSignature , FunctionBody , PatternSignature , WarningPragma :: [RdrName] -> HsDecl GhcPs ormolu-0.1.2.0/data/examples/declaration/signature/pattern/single-line-out.hs0000644000000000000000000000016207346545000025416 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} pattern Arrow :: Type -> Type -> Type pattern Foo, Bar :: Type -> Type -> Type ormolu-0.1.2.0/data/examples/declaration/signature/pattern/single-line.hs0000644000000000000000000000016207346545000024611 0ustar0000000000000000{-# LANGUAGE PatternSynonyms #-} pattern Arrow :: Type -> Type -> Type pattern Foo, Bar :: Type -> Type -> Type ormolu-0.1.2.0/data/examples/declaration/signature/set-cost-centre/0000755000000000000000000000000007346545000023412 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/set-cost-centre/set-cost-centre-out.hs0000644000000000000000000000032207346545000027567 0ustar0000000000000000f 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" #-} ormolu-0.1.2.0/data/examples/declaration/signature/set-cost-centre/set-cost-centre.hs0000644000000000000000000000032307346545000026763 0ustar0000000000000000f 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" #-} ormolu-0.1.2.0/data/examples/declaration/signature/specialize/0000755000000000000000000000000007346545000022523 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/specialize/specialize-instance-out.hs0000644000000000000000000000055507346545000027623 0ustar0000000000000000data 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 ormolu-0.1.2.0/data/examples/declaration/signature/specialize/specialize-instance.hs0000644000000000000000000000056007346545000027012 0ustar0000000000000000data 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 ormolu-0.1.2.0/data/examples/declaration/signature/specialize/specialize-out.hs0000644000000000000000000000075207346545000026020 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/signature/specialize/specialize.hs0000644000000000000000000000100307346545000025201 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/signature/type/0000755000000000000000000000000007346545000021354 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/signature/type/arguments-out.hs0000644000000000000000000000034607346545000024525 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/signature/type/arguments.hs0000644000000000000000000000036107346545000023715 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/signature/type/context-multi-line-out.hs0000644000000000000000000000013107346545000026251 0ustar0000000000000000functionName :: ( C1, C2, C3 ) => a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/context-multi-line.hs0000644000000000000000000000014007346545000025444 0ustar0000000000000000functionName :: ( C1 , C2 , C3 ) => a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/context-single-line-out.hs0000644000000000000000000000011507346545000026402 0ustar0000000000000000functionName :: (C1, C2, C3) => a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/context-single-line.hs0000644000000000000000000000011507346545000025575 0ustar0000000000000000functionName :: (C1, C2, C3) => a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/infix-promoted-type-constructor-out.hs0000644000000000000000000000016407346545000031024 0ustar0000000000000000fun1 :: Def ('[Ref s (Stored Uint32), IBool] 'T.:-> IBool) fun2 :: Def ('[Ref s (Stored Uint32), IBool] ':-> IBool) ormolu-0.1.2.0/data/examples/declaration/signature/type/infix-promoted-type-constructor.hs0000644000000000000000000000016607346545000030221 0ustar0000000000000000fun1 :: Def ('[ Ref s (Stored Uint32), IBool] 'T.:-> IBool) fun2 :: Def ('[ Ref s (Stored Uint32), IBool] ':-> IBool) ormolu-0.1.2.0/data/examples/declaration/signature/type/long-function-name-out.hs0000644000000000000000000000007707346545000026221 0ustar0000000000000000longFunctionName :: a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/long-function-name.hs0000644000000000000000000000007707346545000025414 0ustar0000000000000000longFunctionName :: a -> b -> c -> d -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/long-multiline-applications-out.hs0000644000000000000000000000043007346545000030135 0ustar0000000000000000functionName :: (C1, C2, C3, C4, C5) => forall a b c. a -> b -> ( LongDataTypeName AnotherLongDataTypeName AnotherLongDataTypeName2 AnotherLongDataTypeName3 -> a -> AnotherLongDataTypeName4 -> b -> c ) -> (c -> d) -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/long-multiline-applications.hs0000644000000000000000000000045607346545000027340 0ustar0000000000000000functionName :: (C1, C2, C3, C4, C5) => forall a b c . a -> b -> ( LongDataTypeName AnotherLongDataTypeName AnotherLongDataTypeName2 AnotherLongDataTypeName3 -> a -> AnotherLongDataTypeName4 -> b -> c ) -> (c -> d) -> (a, b, c, d) ormolu-0.1.2.0/data/examples/declaration/signature/type/multi-value-out.hs0000644000000000000000000000016007346545000024756 0ustar0000000000000000foo, bar :: Int foo = 1 bar = 2 a, b, c :: Int a = 1 b = 2 c = 3 foo, bar, baz :: Int bar = 2 baz = 3 ormolu-0.1.2.0/data/examples/declaration/signature/type/multi-value.hs0000644000000000000000000000015607346545000024156 0ustar0000000000000000foo, bar :: Int foo = 1 bar = 2 a, b, c :: Int a = 1 b = 2 c = 3 foo, bar, baz :: Int bar = 2 baz = 3 ormolu-0.1.2.0/data/examples/declaration/signature/type/unicode-out.hs0000644000000000000000000000012607346545000024142 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax #-} foo :: forall a. Show a => a -> String foo = const () ormolu-0.1.2.0/data/examples/declaration/signature/type/unicode.hs0000644000000000000000000000012507346545000023334 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax #-} foo ∷ ∀a. Show a ⇒ a → String foo = const () ormolu-0.1.2.0/data/examples/declaration/signature/type/unrelated-out.hs0000644000000000000000000000022307346545000024475 0ustar0000000000000000clientFunc1 :: SomeType1 clientFunc2 :: SomeType2 clientFunc3 :: SomeType3 clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz ormolu-0.1.2.0/data/examples/declaration/signature/type/unrelated.hs0000644000000000000000000000022307346545000023670 0ustar0000000000000000clientFunc1 :: SomeType1 clientFunc2 :: SomeType2 clientFunc3 :: SomeType3 clientFunc1 :<|> clientFunc2 :<|> clientFunc3 = hoistClient foo bar baz ormolu-0.1.2.0/data/examples/declaration/splice/0000755000000000000000000000000007346545000017651 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/splice/bracket-declaration-out.hs0000644000000000000000000000060307346545000024707 0ustar0000000000000000{-# 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) |] ) ormolu-0.1.2.0/data/examples/declaration/splice/bracket-declaration.hs0000644000000000000000000000060507346545000024104 0ustar0000000000000000{-# 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) |]) ormolu-0.1.2.0/data/examples/declaration/splice/bracket-out.hs0000644000000000000000000000021607346545000022424 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} foo = [| foo bar |] foo = [e| foo bar |] foo = [t|Char|] foo = [|| foo bar ||] ormolu-0.1.2.0/data/examples/declaration/splice/bracket.hs0000644000000000000000000000021107346545000021612 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} foo = [| foo bar |] foo = [e| foo bar |] foo = [t| Char |] foo = [|| foo bar ||] ormolu-0.1.2.0/data/examples/declaration/splice/grouped-splices-out.hs0000644000000000000000000000014007346545000024112 0ustar0000000000000000$(deriveJSON fieldLabelMod ''A) $(deriveJSON fieldLabelMod ''B) $(deriveJSON fieldLabelMod ''C) ormolu-0.1.2.0/data/examples/declaration/splice/grouped-splices.hs0000644000000000000000000000014007346545000023305 0ustar0000000000000000$(deriveJSON fieldLabelMod ''A) $(deriveJSON fieldLabelMod ''B) $(deriveJSON fieldLabelMod ''C) ormolu-0.1.2.0/data/examples/declaration/splice/quasiquote-out.hs0000644000000000000000000000015707346545000023215 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} x = [foo| foo bar |] x = [e| foo bar {- -} |] [d| foo bar |] ormolu-0.1.2.0/data/examples/declaration/splice/quasiquote.hs0000644000000000000000000000015507346545000022406 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} x = [foo| foo bar |] x = [e| foo bar {- -} |] [d| foo bar |] ormolu-0.1.2.0/data/examples/declaration/splice/quotes-out.hs0000644000000000000000000000022707346545000022333 0ustar0000000000000000foo = ''R bar = 'foo bar' = 'foo_bar baz = ''(:#) baz' = ''(Foo.Bar.:#) equals = ''(==) unit = ''() list = ''[] quolified = ''Semigroup.Option ormolu-0.1.2.0/data/examples/declaration/splice/quotes.hs0000644000000000000000000000022707346545000021526 0ustar0000000000000000foo = ''R bar = 'foo bar' = 'foo_bar baz = ''(:#) baz' = ''(Foo.Bar.:#) equals = ''(==) unit = ''() list = ''[] quolified = ''Semigroup.Option ormolu-0.1.2.0/data/examples/declaration/splice/splice-decl-out.hs0000644000000000000000000000023107346545000023172 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} $(foo bar) $foo $$(foo bar) $$foo foo bar [|booya|] -- TemplateHaskell allows Q () at the top level do pure [] ormolu-0.1.2.0/data/examples/declaration/splice/splice-decl.hs0000644000000000000000000000025107346545000022367 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} $( foo bar) $foo $$( foo bar) $$foo foo bar [|booya|] -- TemplateHaskell allows Q () at the top level do pure [] ormolu-0.1.2.0/data/examples/declaration/splice/typed-splice-out.hs0000644000000000000000000000010507346545000023410 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} x = $$( foo bar ) x = $$foo ormolu-0.1.2.0/data/examples/declaration/splice/typed-splice.hs0000644000000000000000000000012507346545000022605 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} x = $$( foo bar ) x = $$foo ormolu-0.1.2.0/data/examples/declaration/splice/untyped-splice-out.hs0000644000000000000000000000013107346545000023752 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} x = $(foo bar) x = $( foo bar ) x = $foo ormolu-0.1.2.0/data/examples/declaration/splice/untyped-splice.hs0000644000000000000000000000016107346545000023150 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} x = $( foo bar ) x = $( foo bar ) x = $foo ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/0000755000000000000000000000000007346545000024651 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/infix-out.hs0000644000000000000000000000051307346545000027126 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/infix.hs0000644000000000000000000000051307346545000026321 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/injective-out.hs0000644000000000000000000000020107346545000027763 0ustar0000000000000000type 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) ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/injective.hs0000644000000000000000000000020007346545000027155 0ustar0000000000000000type 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) ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/multi-line-out.hs0000644000000000000000000000040207346545000030065 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/multi-line.hs0000644000000000000000000000037307346545000027267 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/no-annotation-out.hs0000644000000000000000000000010607346545000030573 0ustar0000000000000000type family F a where F Int = Double F Bool = Char F a = String ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/no-annotation.hs0000644000000000000000000000011207346545000027763 0ustar0000000000000000type family F a where F Int = Double F Bool = Char F a = String ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/simple-out.hs0000644000000000000000000000016707346545000027307 0ustar0000000000000000module Main where -- | Documentation. type family F a :: * -> * where F Int = Double F Bool = Char F a = String ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/simple.hs0000644000000000000000000000017407346545000026500 0ustar0000000000000000module Main where -- | Documentation. type family F a :: * -> * where F Int = Double F Bool = Char F a = String ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/with-equal-sign-out.hs0000644000000000000000000000006107346545000031025 0ustar0000000000000000type family TF a b = result where TF a b = Int ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/with-equal-sign.hs0000644000000000000000000000006107346545000030220 0ustar0000000000000000type family TF a b = result where TF a b = Int ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/with-forall-out.hs0000644000000000000000000000013207346545000030236 0ustar0000000000000000type family G a b where forall x y. G [x] (Proxy y) = Double forall z. z `G` z = Bool ormolu-0.1.2.0/data/examples/declaration/type-families/closed-type-family/with-forall.hs0000644000000000000000000000013207346545000027431 0ustar0000000000000000type family G a b where forall x y. G [x] (Proxy y) = Double forall z. z `G` z = Bool ormolu-0.1.2.0/data/examples/declaration/type-families/data-family/0000755000000000000000000000000007346545000023332 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/type-families/data-family/no-annotation-out.hs0000644000000000000000000000007307346545000027257 0ustar0000000000000000module Main where -- | Documentation. data family Array e ormolu-0.1.2.0/data/examples/declaration/type-families/data-family/no-annotation.hs0000644000000000000000000000007407346545000026453 0ustar0000000000000000module Main where -- | Documentation. data family Array e ormolu-0.1.2.0/data/examples/declaration/type-families/data-family/simple-out.hs0000644000000000000000000000011207346545000025756 0ustar0000000000000000module Main where -- | Documentation. data family GMap k :: Type -> Type ormolu-0.1.2.0/data/examples/declaration/type-families/data-family/simple.hs0000644000000000000000000000011307346545000025152 0ustar0000000000000000module Main where -- | Documentation. data family GMap k :: Type -> Type ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/0000755000000000000000000000000007346545000023402 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/injective-out.hs0000644000000000000000000000010407346545000026516 0ustar0000000000000000type family Id a = r | r -> a type family F a b c = d | d -> a c b ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/injective.hs0000644000000000000000000000010307346545000025710 0ustar0000000000000000type family Id a = r | r -> a type family F a b c = d | d -> a c b ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/no-annotation-out.hs0000644000000000000000000000011107346545000027320 0ustar0000000000000000module Main where -- | Documentation. type family F a b :: Type -> Type ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/no-annotation.hs0000644000000000000000000000011207346545000026514 0ustar0000000000000000module Main where -- | Documentation. type family F a b :: Type -> Type ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/operator-out.hs0000644000000000000000000000004507346545000026375 0ustar0000000000000000type family a ! b type family a . b ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/operator.hs0000644000000000000000000000004407346545000025567 0ustar0000000000000000type family a ! b type family a . b ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/simple-out.hs0000644000000000000000000000010207346545000026025 0ustar0000000000000000module Main where -- | Documentation. type family Elem c :: Type ormolu-0.1.2.0/data/examples/declaration/type-families/type-family/simple.hs0000644000000000000000000000010307346545000025221 0ustar0000000000000000module Main where -- | Documentation. type family Elem c :: Type ormolu-0.1.2.0/data/examples/declaration/type-synonyms/0000755000000000000000000000000007346545000021250 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/type-synonyms/multi-line-out.hs0000644000000000000000000000034207346545000024467 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-synonyms/multi-line.hs0000644000000000000000000000034607346545000023666 0ustar0000000000000000type 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 ormolu-0.1.2.0/data/examples/declaration/type-synonyms/simple-out.hs0000644000000000000000000000017607346545000023706 0ustar0000000000000000module 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 = () ormolu-0.1.2.0/data/examples/declaration/type-synonyms/simple.hs0000644000000000000000000000017707346545000023102 0ustar0000000000000000module 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 = () ormolu-0.1.2.0/data/examples/declaration/type-synonyms/with-weird-haddock-out.hs0000644000000000000000000000010107346545000026057 0ustar0000000000000000type Elims = -- | eliminations ordered left-to-right. [Elim] ormolu-0.1.2.0/data/examples/declaration/type-synonyms/with-weird-haddock.hs0000644000000000000000000000007607346545000025265 0ustar0000000000000000type Elims = [Elim] -- ^ eliminations ordered left-to-right. ormolu-0.1.2.0/data/examples/declaration/type/0000755000000000000000000000000007346545000017353 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/type/forall-out.hs0000644000000000000000000000011707346545000021772 0ustar0000000000000000type CoerceLocalSig m m' = forall r a. LocalSig m r a -> LocalSig m' r a ormolu-0.1.2.0/data/examples/declaration/type/forall.hs0000644000000000000000000000012007346545000021157 0ustar0000000000000000type CoerceLocalSig m m' = forall r a. LocalSig m r a -> LocalSig m' r a ormolu-0.1.2.0/data/examples/declaration/type/lits-out.hs0000644000000000000000000000006107346545000021464 0ustar0000000000000000type A = "foo" type B = "foo\ \bar" -> () ormolu-0.1.2.0/data/examples/declaration/type/lits.hs0000644000000000000000000000006407346545000020662 0ustar0000000000000000type A = "foo" type B = "foo\ \bar" -> () ormolu-0.1.2.0/data/examples/declaration/type/misc-kind-signatures-out.hs0000644000000000000000000000014707346545000024556 0ustar0000000000000000instance DemoteNodeTypes ('[] :: [NodeType]) where demoteNodeTypes _ = [] b :: (Bool :: *) b = True ormolu-0.1.2.0/data/examples/declaration/type/misc-kind-signatures.hs0000644000000000000000000000015107346545000023744 0ustar0000000000000000instance DemoteNodeTypes ('[] :: [NodeType]) where demoteNodeTypes _ = [] b :: (Bool :: *) b = True ormolu-0.1.2.0/data/examples/declaration/type/promotion-out.hs0000644000000000000000000000046307346545000022545 0ustar0000000000000000type 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]) ormolu-0.1.2.0/data/examples/declaration/type/promotion.hs0000644000000000000000000000047407346545000021742 0ustar0000000000000000type 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 ]) ormolu-0.1.2.0/data/examples/declaration/type/splice-out.hs0000644000000000000000000000007507346545000021775 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} type Foo = $(bar [t|Int|]) ormolu-0.1.2.0/data/examples/declaration/type/splice.hs0000644000000000000000000000011207346545000021160 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} type Foo = $( bar [t|Int|] ) ormolu-0.1.2.0/data/examples/declaration/type/type-applications-out.hs0000644000000000000000000000011607346545000024157 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} type P = K @Bool @(Bool :: *) 'True 'False ormolu-0.1.2.0/data/examples/declaration/type/type-applications.hs0000644000000000000000000000011607346545000023352 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} type P = K @Bool @(Bool :: *) 'True 'False ormolu-0.1.2.0/data/examples/declaration/type/visible-forall-out.hs0000644000000000000000000000020607346545000023424 0ustar0000000000000000-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst data T :: forall k -> k -> Type ormolu-0.1.2.0/data/examples/declaration/type/visible-forall.hs0000644000000000000000000000020607346545000022617 0ustar0000000000000000-- source: https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0081-forall-arrow.rst data T :: forall k -> k -> Type ormolu-0.1.2.0/data/examples/declaration/value/function/0000755000000000000000000000000007346545000021333 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/application-0-out.hs0000644000000000000000000000014507346545000025134 0ustar0000000000000000foo = f1 p1 p2 p3 foo' = f2 p1 p2 p3 foo'' = f3 p1 p2 p3 ormolu-0.1.2.0/data/examples/declaration/value/function/application-0.hs0000644000000000000000000000011707346545000024326 0ustar0000000000000000foo = f1 p1 p2 p3 foo' = f2 p1 p2 p3 foo'' = f3 p1 p2 p3 ormolu-0.1.2.0/data/examples/declaration/value/function/application-1-out.hs0000644000000000000000000000017507346545000025140 0ustar0000000000000000main = do x y z main = case foo of x -> a foo a b main = do if x then y else z foo a b ormolu-0.1.2.0/data/examples/declaration/value/function/application-1.hs0000644000000000000000000000016207346545000024327 0ustar0000000000000000main = do x y z main = case foo of x -> a foo a b main = do if x then y else z foo a b ormolu-0.1.2.0/data/examples/declaration/value/function/arg-breakpoints-out.hs0000644000000000000000000000002507346545000025561 0ustar0000000000000000foo bar = body ormolu-0.1.2.0/data/examples/declaration/value/function/arg-breakpoints.hs0000644000000000000000000000002507346545000024754 0ustar0000000000000000foo bar = body ormolu-0.1.2.0/data/examples/declaration/value/function/arithmetic-sequences-out.hs0000644000000000000000000000032707346545000026620 0ustar0000000000000000foo = [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] ormolu-0.1.2.0/data/examples/declaration/value/function/arithmetic-sequences.hs0000644000000000000000000000031307346545000026006 0ustar0000000000000000foo = [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] ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/0000755000000000000000000000000007346545000022465 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/multiline-case-out.hs0000644000000000000000000000014207346545000026536 0ustar0000000000000000{-# LANGUAGE Arrows #-} f = proc x -> do x <- case x of X -> x -< y a -< b ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/multiline-case.hs0000644000000000000000000000013007346545000025726 0ustar0000000000000000{-# LANGUAGE Arrows #-} f = proc x -> do x <- case x of X -> x -< y a -< b ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-applications-out.hs0000644000000000000000000000034707346545000027261 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-applications.hs0000644000000000000000000000034007346545000026445 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-cases-out.hs0000644000000000000000000000041407346545000025664 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-cases.hs0000644000000000000000000000046707346545000025067 0ustar0000000000000000{-# LANGUAGE Arrows #-} foo f =proc a -> case a of Left b -> f - case a of Left ( (a, b), (c, d) ) -> f (a <> c) -< b <> d Right (Left a) -> h -< a Right (Right b) -> j -< b ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-complex-out.hs0000644000000000000000000000272407346545000026643 0ustar0000000000000000{-# 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 ) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-complex.hs0000644000000000000000000000253307346545000026034 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-simple1-out.hs0000644000000000000000000000035107346545000026540 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-simple1.hs0000644000000000000000000000037207346545000025736 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-simple2-out.hs0000644000000000000000000000037307346545000026545 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-do-simple2.hs0000644000000000000000000000042407346545000025735 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-forms1-out.hs0000644000000000000000000000050407346545000025775 0ustar0000000000000000{-# 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 ) |) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-forms1.hs0000644000000000000000000000044607346545000025175 0ustar0000000000000000{-# 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) |) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-forms2-out.hs0000644000000000000000000000066407346545000026005 0ustar0000000000000000{-# 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) ) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-forms2.hs0000644000000000000000000000061307346545000025172 0ustar0000000000000000{-# LANGUAGE Arrows #-} bar0 f g h x = proc (y, z) -> (| test (h f.(h g) -< (y x).y z)((h g) . h f- (f -< x)&&&(g -< y) bar2 f g h x = proc (y, z) -> (h f.(h g) -< (y x).y z) ||| ((h g) . h f- ((h f.h g) -< (y x).y z) ||| ((h g . h f) - if a then f -< 0 else f -< 1 bar f g = proc a -> if f a then f . g -< a else g -< b ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-ifs.hs0000644000000000000000000000027607346545000024550 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-lambdas-out.hs0000644000000000000000000000025107346545000026170 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-lambdas.hs0000644000000000000000000000026307346545000025366 0ustar0000000000000000{-# LANGUAGE Arrows #-} foo = proc a-> \f b->a- \f g h -> \() -> \( Left (x,y )) -> -- Tuple value f (g (h x)) -< y ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-lets-out.hs0000644000000000000000000000025507346545000025540 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-lets.hs0000644000000000000000000000027407346545000024734 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-parentheses-out.hs0000644000000000000000000000040407346545000027106 0ustar0000000000000000{-# LANGUAGE Arrows #-} foo f = proc a -> (f -< a) bar f g = proc a -> ( ( (f) ( g ) ) -< ( ( ( ( ( ( g a ) ) ) ) ) ) ) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/proc-parentheses.hs0000644000000000000000000000024207346545000026301 0ustar0000000000000000{-# LANGUAGE Arrows #-} foo f = proc a -> ( f -< a ) bar f g = proc a -> ( ((f) ( g )) -< ((((( (g a) ))))) ) ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/recursive-procs-out.hs0000644000000000000000000000043507346545000026763 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/arrow/recursive-procs.hs0000644000000000000000000000033107346545000026151 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/awkward-comment-0-out.hs0000644000000000000000000000035307346545000025732 0ustar0000000000000000mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a mergeErrorReply err1 reply -- XXX where to put it? = case reply of Ok x state err2 -> Ok x state (mergeError err1 err2) Error err2 -> Error (mergeError err1 err2) ormolu-0.1.2.0/data/examples/declaration/value/function/awkward-comment-0.hs0000644000000000000000000000037007346545000025124 0ustar0000000000000000mergeErrorReply :: ParseError -> Reply s u a -> Reply s u a mergeErrorReply err1 reply -- XXX where to put it? = case reply of Ok x state err2 -> Ok x state (mergeError err1 err2) Error err2 -> Error (mergeError err1 err2) ormolu-0.1.2.0/data/examples/declaration/value/function/awkward-comment-1-out.hs0000644000000000000000000000041707346545000025734 0ustar0000000000000000doForeign :: Vars -> [Name] -> [Term] -> Idris LExp doForeign x = x where splitArg tm | (_, [_, _, l, r]) <- unApply tm -- pair, two implicits = do let l' = toFDesc l r' <- irTerm (sMN 0 "__foreignCall") vs env r return (l', r') ormolu-0.1.2.0/data/examples/declaration/value/function/awkward-comment-1.hs0000644000000000000000000000041207346545000025122 0ustar0000000000000000doForeign :: Vars -> [Name] -> [Term] -> Idris LExp doForeign x = x where splitArg tm | (_, [_,_,l,r]) <- unApply tm -- pair, two implicits = do let l' = toFDesc l r' <- irTerm (sMN 0 "__foreignCall") vs env r return (l', r') ormolu-0.1.2.0/data/examples/declaration/value/function/backticks-lhs-out.hs0000644000000000000000000000015507346545000025217 0ustar0000000000000000x `op1` (Just 0) = True op1 x (Just _) = False op1 x Nothing = undefined op2 1 y = False x `op2` y = True ormolu-0.1.2.0/data/examples/declaration/value/function/backticks-lhs.hs0000644000000000000000000000021607346545000024410 0ustar0000000000000000x `op1` (Just 0) = True op1 x (Just _) = False op1 x Nothing = undefined op2 1 y = False x `op2` y = True ormolu-0.1.2.0/data/examples/declaration/value/function/backticks-out.hs0000644000000000000000000000002407346545000024426 0ustar0000000000000000foo x y = x `bar` y ormolu-0.1.2.0/data/examples/declaration/value/function/backticks.hs0000644000000000000000000000002407346545000023621 0ustar0000000000000000foo x y = x `bar` y ormolu-0.1.2.0/data/examples/declaration/value/function/blank-lines-let-out.hs0000644000000000000000000000007607346545000025460 0ustar0000000000000000foo = let x = 10 y = 11 z = 12 in x + y + z ormolu-0.1.2.0/data/examples/declaration/value/function/blank-lines-let.hs0000644000000000000000000000007707346545000024654 0ustar0000000000000000foo = let x = 10 y = 11 z = 12 in x + y + z ormolu-0.1.2.0/data/examples/declaration/value/function/blank-lines-where-out.hs0000644000000000000000000000007207346545000026002 0ustar0000000000000000foo = x + y + z where x = 10 y = 11 z = 12 ormolu-0.1.2.0/data/examples/declaration/value/function/blank-lines-where.hs0000644000000000000000000000007307346545000025176 0ustar0000000000000000foo = x + y + z where x = 10 y = 11 z = 12 ormolu-0.1.2.0/data/examples/declaration/value/function/block-arguments-out.hs0000644000000000000000000000047207346545000025574 0ustar0000000000000000f1 = foo do bar f2 = foo do bar f3 = foo case True of True -> bar False -> baz f4 = foo let a = 3 in b f5 = foo let a = 3 b = a in b f6 = foo if bar then baz else not baz f7 = foo \x -> y f8 = foo \x -> y f9 = foo do { bar } baz f10 = foo do a do b do c ormolu-0.1.2.0/data/examples/declaration/value/function/block-arguments.hs0000644000000000000000000000050607346545000024765 0ustar0000000000000000f1 = foo do bar f2 = foo do bar f3 = foo case True of True -> bar False -> baz f4 = foo let a = 3 in b f5 = foo let a = 3 b = a in b f6 = foo if bar then baz else not baz f7 = foo \x -> y f8 = foo \x -> y f9 = foo do { bar } baz f10 = foo do { a } do { b } do c ormolu-0.1.2.0/data/examples/declaration/value/function/builtin-syntax-out.hs0000644000000000000000000000001607346545000025463 0ustar0000000000000000x = return () ormolu-0.1.2.0/data/examples/declaration/value/function/builtin-syntax.hs0000644000000000000000000000001607346545000024656 0ustar0000000000000000x = return () ormolu-0.1.2.0/data/examples/declaration/value/function/case-multi-line-guards-out.hs0000644000000000000000000000037707346545000026756 0ustar0000000000000000withGuards :: 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 '*' ormolu-0.1.2.0/data/examples/declaration/value/function/case-multi-line-guards.hs0000644000000000000000000000040107346545000026135 0ustar0000000000000000withGuards :: 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 '*' ormolu-0.1.2.0/data/examples/declaration/value/function/case-multi-line-out.hs0000644000000000000000000000050307346545000025462 0ustar0000000000000000foo :: 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 () -> () ormolu-0.1.2.0/data/examples/declaration/value/function/case-multi-line.hs0000644000000000000000000000050407346545000024656 0ustar0000000000000000foo :: 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 () -> () ormolu-0.1.2.0/data/examples/declaration/value/function/case-single-line-out.hs0000644000000000000000000000025407346545000025614 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/case-single-line.hs0000644000000000000000000000025407346545000025007 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/complex-list-out.hs0000644000000000000000000000027307346545000025116 0ustar0000000000000000handleStuff = handle [ \ExceptionA -> something, \ExceptionB -> somethingElse ] handleStuff = handle [ foo bar, baz qux ] ormolu-0.1.2.0/data/examples/declaration/value/function/complex-list.hs0000644000000000000000000000027107346545000024307 0ustar0000000000000000handleStuff = handle [ \ExceptionA -> something , \ExceptionB -> somethingElse ] handleStuff = handle [ foo bar , baz qux ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/0000755000000000000000000000000007346545000024204 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line1-out.hs0000644000000000000000000000026007346545000031514 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} foo' xs ys = [ ( x, y ) | x <- xs, y <- ys, then -- First comment reverse -- Second comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line1.hs0000644000000000000000000000022107346545000030704 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} foo' xs ys = [ (x, y) | x <- xs, y <- ys, then -- First comment reverse -- Second comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line2-out.hs0000644000000000000000000000034007346545000031514 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} bar' xs ys = [ ( x, y ) | x <- xs, y <- ys, then -- First comment sortWith by ( x + y -- Second comment ) ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line2.hs0000644000000000000000000000025407346545000030713 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} bar' xs ys = [ (x, y) | x <- xs, y <- ys, then -- First comment sortWith by (x + y) -- Second comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line3-out.hs0000644000000000000000000000030107346545000031512 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} baz' xs ys = [ ( x, y ) | x <- xs, y <- ys, then group using -- First comment permutations -- Second comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line3.hs0000644000000000000000000000024707346545000030716 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} baz' xs ys = [ (x, y) | x <- xs, y <- ys, then group using -- First comment permutations -- Second comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line4-out.hs0000644000000000000000000000040707346545000031522 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} quux' xs ys = [ ( x, y ) | x <- xs, y <- ys, then group by -- First comment ( x + y ) using -- Second comment groupWith -- Third comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-multi-line4.hs0000644000000000000000000000031507346545000030713 0ustar0000000000000000{-# LANGUAGE TransformListComp #-} quux' xs ys = [ (x, y) | x <- xs, y <- ys, then group by -- First comment (x + y) using -- Second comment groupWith -- Third comment ] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-single-line-out.hs0000644000000000000000000000046607346545000031572 0ustar0000000000000000{-# 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] ormolu-0.1.2.0/data/examples/declaration/value/function/comprehension/transform-single-line.hs0000644000000000000000000000046607346545000030765 0ustar0000000000000000{-# 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] ormolu-0.1.2.0/data/examples/declaration/value/function/do-single-multi-out.hs0000644000000000000000000000004107346545000025500 0ustar0000000000000000foo = do ( bar baz ) ormolu-0.1.2.0/data/examples/declaration/value/function/do-single-multi.hs0000644000000000000000000000003507346545000024676 0ustar0000000000000000foo = do (bar baz) ormolu-0.1.2.0/data/examples/declaration/value/function/do-where-out.hs0000644000000000000000000000006307346545000024205 0ustar0000000000000000f :: Maybe Int f = do return c where c = 0 ormolu-0.1.2.0/data/examples/declaration/value/function/do-where.hs0000644000000000000000000000006307346545000023400 0ustar0000000000000000f :: Maybe Int f = do return c where c = 0 ormolu-0.1.2.0/data/examples/declaration/value/function/do/0000755000000000000000000000000007346545000021735 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/do/applications-and-parens-out.hs0000644000000000000000000000034407346545000027613 0ustar0000000000000000warningFor var place = do guard $ isVariableName var guard . not $ isInArray var place || isGuarded place ( if includeGlobals || isLocal var then warningForLocals else warningForGlobals ) var place ormolu-0.1.2.0/data/examples/declaration/value/function/do/applications-and-parens.hs0000644000000000000000000000033207346545000027003 0ustar0000000000000000warningFor var place = do guard $ isVariableName var guard . not $ isInArray var place || isGuarded place (if includeGlobals || isLocal var then warningForLocals else warningForGlobals) var place ormolu-0.1.2.0/data/examples/declaration/value/function/do/blocks-out.hs0000644000000000000000000000042707346545000024356 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/do/blocks.hs0000644000000000000000000000051607346545000023550 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/do/comment-alignment-out.hs0000644000000000000000000000022107346545000026507 0ustar0000000000000000main = do case blah of Nothing -> return () Just xs -> do forM_ xs foo bar -- and here it goes unless bobla $ quux ormolu-0.1.2.0/data/examples/declaration/value/function/do/comment-alignment.hs0000644000000000000000000000022107346545000025702 0ustar0000000000000000main = do case blah of Nothing -> return () Just xs -> do forM_ xs foo bar -- and here it goes unless bobla $ quux ormolu-0.1.2.0/data/examples/declaration/value/function/do/comment-spacing-out.hs0000644000000000000000000000005707346545000026164 0ustar0000000000000000foo = do bar -- foo baz -- foo quux ormolu-0.1.2.0/data/examples/declaration/value/function/do/comment-spacing.hs0000644000000000000000000000005707346545000025357 0ustar0000000000000000foo = do bar -- foo baz -- foo quux ormolu-0.1.2.0/data/examples/declaration/value/function/do/expr-out.hs0000644000000000000000000000016107346545000024052 0ustar0000000000000000quux = something $ do foo case x of 1 -> 10 2 -> 20 bar if something then x else y baz ormolu-0.1.2.0/data/examples/declaration/value/function/do/expr.hs0000644000000000000000000000015507346545000023250 0ustar0000000000000000quux = something $ do foo case x of 1 -> 10 2 -> 20 bar if something then x else y baz ormolu-0.1.2.0/data/examples/declaration/value/function/do/hang-rhs-arrow-out.hs0000644000000000000000000000027307346545000025737 0ustar0000000000000000foo = do something <- case bar of Foo -> return 1 Bar -> return 2 somethingElse <- case boom of Foo -> return 1 Bar -> return 2 quux something somethingElse ormolu-0.1.2.0/data/examples/declaration/value/function/do/hang-rhs-arrow.hs0000644000000000000000000000027307346545000025132 0ustar0000000000000000foo = do something <- case bar of Foo -> return 1 Bar -> return 2 somethingElse <- case boom of Foo -> return 1 Bar -> return 2 quux something somethingElse ormolu-0.1.2.0/data/examples/declaration/value/function/do/let-out.hs0000644000000000000000000000041207346545000023657 0ustar0000000000000000main = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/do/let.hs0000644000000000000000000000042007346545000023051 0ustar0000000000000000main = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/do/operator-and-parens-out.hs0000644000000000000000000000037507346545000026764 0ustar0000000000000000scientifically :: (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) ormolu-0.1.2.0/data/examples/declaration/value/function/do/operator-and-parens.hs0000644000000000000000000000037507346545000026157 0ustar0000000000000000scientifically :: (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) ormolu-0.1.2.0/data/examples/declaration/value/function/do/recursive-do-mdo-out.hs0000644000000000000000000000020507346545000026257 0ustar0000000000000000{-# LANGUAGE RecursiveDo #-} baz = mdo bar a a <- foo b <- bar 1 2 3 return (a + b) ormolu-0.1.2.0/data/examples/declaration/value/function/do/recursive-do-mdo.hs0000644000000000000000000000016107346545000025453 0ustar0000000000000000{-# LANGUAGE RecursiveDo #-} baz = mdo bar a a <- foo b <- bar 1 2 3 return (a + b) ormolu-0.1.2.0/data/examples/declaration/value/function/do/recursive-do-rec-out.hs0000644000000000000000000000033407346545000026254 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/do/recursive-do-rec.hs0000644000000000000000000000034007346545000025444 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/equality-constraints-out.hs0000644000000000000000000000006007346545000026672 0ustar0000000000000000foo :: (a ~ b) => a -> b -> Int foo = undefined ormolu-0.1.2.0/data/examples/declaration/value/function/equality-constraints.hs0000644000000000000000000000006007346545000026065 0ustar0000000000000000foo :: (a ~ b) => a -> b -> Int foo = undefined ormolu-0.1.2.0/data/examples/declaration/value/function/explicit-type-out.hs0000644000000000000000000000004507346545000025273 0ustar0000000000000000foo = 5 :: Int bar = 5 :: Int ormolu-0.1.2.0/data/examples/declaration/value/function/explicit-type.hs0000644000000000000000000000004107346545000024462 0ustar0000000000000000foo = 5 :: Int bar = 5 :: Int ormolu-0.1.2.0/data/examples/declaration/value/function/fancy-forall-0-out.hs0000644000000000000000000000042707346545000025211 0ustar0000000000000000wrapError :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/fancy-forall-0.hs0000644000000000000000000000041307346545000024377 0ustar0000000000000000wrapError :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/fancy-forall-1-out.hs0000644000000000000000000000043107346545000025205 0ustar0000000000000000magnify :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/fancy-forall-1.hs0000644000000000000000000000041507346545000024402 0ustar0000000000000000magnify :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/guards-out.hs0000644000000000000000000000032207346545000023756 0ustar0000000000000000baz :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/guards.hs0000644000000000000000000000032207346545000023151 0ustar0000000000000000baz :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/if-multi-line-out.hs0000644000000000000000000000042707346545000025152 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/if-multi-line.hs0000644000000000000000000000042007346545000024336 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/if-single-line-out.hs0000644000000000000000000000015107346545000025273 0ustar0000000000000000foo :: Int -> Int foo x = if x > 5 then 10 else 12 bar :: Int -> Int bar x = if x > 5 then 10 else 12 ormolu-0.1.2.0/data/examples/declaration/value/function/if-single-line.hs0000644000000000000000000000015107346545000024466 0ustar0000000000000000foo :: Int -> Int foo x = if x > 5 then 10 else 12 bar :: Int -> Int bar x = if x > 5 then 10 else 12 ormolu-0.1.2.0/data/examples/declaration/value/function/if-with-comment-out.hs0000644000000000000000000000015707346545000025506 0ustar0000000000000000foo = if undefined then -- then comment undefined else -- else comment do undefined ormolu-0.1.2.0/data/examples/declaration/value/function/if-with-comment.hs0000644000000000000000000000016407346545000024677 0ustar0000000000000000foo = if undefined -- then comment then undefined -- else comment else do undefined ormolu-0.1.2.0/data/examples/declaration/value/function/implicit-params-out.hs0000644000000000000000000000037707346545000025576 0ustar0000000000000000{-# LANGUAGE ImplicitParams #-} sortBy :: (a -> a -> Bool) -> [a] -> [a] sortBy = undefined sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] sort = sortBy ?cmp sort' :: ( ?cmp :: a -> a -> Bool, ?foo :: Int ) => [a] -> [a] sort' = sort ormolu-0.1.2.0/data/examples/declaration/value/function/implicit-params.hs0000644000000000000000000000041007346545000024755 0ustar0000000000000000{-# LANGUAGE ImplicitParams #-} sortBy :: (a -> a -> Bool) -> [a] -> [a] sortBy = undefined sort :: (?cmp :: a -> a -> Bool) => [a] -> [a] sort = sortBy ?cmp sort' :: (?cmp :: a -> a -> Bool ,?foo :: Int) => [a] -> [a] sort' = sort ormolu-0.1.2.0/data/examples/declaration/value/function/infix/0000755000000000000000000000000007346545000022450 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/infix/applicative-out.hs0000644000000000000000000000005307346545000026110 0ustar0000000000000000f = Foo <$> bar <*> baz <*> baz' ormolu-0.1.2.0/data/examples/declaration/value/function/infix/applicative.hs0000644000000000000000000000005707346545000025307 0ustar0000000000000000f = Foo <$> bar <*> baz <*> baz' ormolu-0.1.2.0/data/examples/declaration/value/function/infix/comments-out.hs0000644000000000000000000000010107346545000025426 0ustar0000000000000000main = bar $ -- bar baz -- baz bar $ {- foo -} bar ormolu-0.1.2.0/data/examples/declaration/value/function/infix/comments.hs0000644000000000000000000000010107346545000024621 0ustar0000000000000000main = bar $ -- bar baz -- baz bar $ {- foo -} bar ormolu-0.1.2.0/data/examples/declaration/value/function/infix/do-out.hs0000644000000000000000000000022507346545000024212 0ustar0000000000000000main = do stuff `finally` do recover main = do stuff `finally` recover main = do { stuff } `finally` recover foo = do 1 + 2 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/do.hs0000644000000000000000000000022607346545000023406 0ustar0000000000000000main = do stuff `finally` do recover main = do stuff `finally` recover main = do { stuff } `finally` recover foo = do 1 + 2 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/dollar-chains-out.hs0000644000000000000000000000054207346545000026332 0ustar0000000000000000module Main where foo = fmap escapeLeadingDollar . dropPaddingSpace . dropWhileEnd T.null . fmap (T.stripEnd . T.pack) . lines $ unpackHDS docStr foo = when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $ throwIO (OrmoluCppEnabled path) foo = bar $ baz $ quux x = case l of { A -> B } $ case q of r -> s ormolu-0.1.2.0/data/examples/declaration/value/function/infix/dollar-chains.hs0000644000000000000000000000053607346545000025530 0ustar0000000000000000module Main where foo = fmap escapeLeadingDollar . dropPaddingSpace . dropWhileEnd T.null . fmap (T.stripEnd . T.pack) . lines $ unpackHDS docStr foo = when (GHC.xopt Cpp dynFlags && not cfgTolerateCpp) $ throwIO (OrmoluCppEnabled path) foo = bar $ baz $ quux x = case l of { A -> B } $ case q of r -> s ormolu-0.1.2.0/data/examples/declaration/value/function/infix/hanging-out.hs0000644000000000000000000000032107346545000025220 0ustar0000000000000000f = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/hanging.hs0000644000000000000000000000031507346545000024416 0ustar0000000000000000f = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/lenses-out.hs0000644000000000000000000000076307346545000025110 0ustar0000000000000000lenses = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/lenses.hs0000644000000000000000000000075407346545000024303 0ustar0000000000000000lenses = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/simple-out.hs0000644000000000000000000000026407346545000025104 0ustar0000000000000000(*) :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/simple.hs0000644000000000000000000000026407346545000024277 0ustar0000000000000000(*) :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/infix/unicode-out.hs0000644000000000000000000000006307346545000025236 0ustar0000000000000000main = print ('a' → 'a') where (→) = (,) ormolu-0.1.2.0/data/examples/declaration/value/function/infix/unicode.hs0000644000000000000000000000006307346545000024431 0ustar0000000000000000main = print ('a' → 'a') where (→) = (,) ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-case-out.hs0000644000000000000000000000022007346545000024617 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} foo = bar (\case JKey {} -> True; _ -> False) foo :: Int -> Int foo = \case 5 -> 10 i | i > 5 -> 11 _ -> 12 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-case.hs0000644000000000000000000000022007346545000024012 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} foo = bar (\case JKey{} -> True; _ -> False) foo :: Int -> Int foo = \case 5 -> 10 i | i > 5 -> 11 _ -> 12 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-multi-line1-out.hs0000644000000000000000000000040607346545000026052 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-multi-line1.hs0000644000000000000000000000037507346545000025252 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-multi-line2-out.hs0000644000000000000000000000046107346545000026054 0ustar0000000000000000tricky0 = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-multi-line2.hs0000644000000000000000000000045307346545000025250 0ustar0000000000000000tricky0 = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-single-line-out.hs0000644000000000000000000000033407346545000026120 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/lambda-single-line.hs0000644000000000000000000000033607346545000025315 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/let-multi-line-out.hs0000644000000000000000000000061307346545000025335 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/let-multi-line.hs0000644000000000000000000000060607346545000024532 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/let-nested-out.hs0000644000000000000000000000004607346545000024540 0ustar0000000000000000_ = _ where _ = [_ | let _ = _] ormolu-0.1.2.0/data/examples/declaration/value/function/let-nested.hs0000644000000000000000000000004607346545000023733 0ustar0000000000000000_ = _ where _ = [_ | let _ = _] ormolu-0.1.2.0/data/examples/declaration/value/function/let-single-line-out.hs0000644000000000000000000000046307346545000025467 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/let-single-line.hs0000644000000000000000000000046607346545000024665 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/list-comprehensions-out.hs0000644000000000000000000000056707346545000026511 0ustar0000000000000000foo 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 ] ] ormolu-0.1.2.0/data/examples/declaration/value/function/list-comprehensions.hs0000644000000000000000000000051207346545000025672 0ustar0000000000000000foo 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 ] ] ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-0-out.hs0000644000000000000000000000013407346545000025433 0ustar0000000000000000foo = testCase "Foo" testFoo : testCase "Bar" testBar : testCase "Baz" testBaz : [] ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-0.hs0000644000000000000000000000013407346545000024626 0ustar0000000000000000foo = testCase "Foo" testFoo : testCase "Bar" testBar : testCase "Baz" testBaz : [] ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-1-out.hs0000644000000000000000000000043707346545000025442 0ustar0000000000000000instance A.ToJSON UpdateTable where toJSON a = A.object $ "TableName" .= updateTableName a : "ProvisionedThroughput" .= updateProvisionedThroughput a : case updateGlobalSecondaryIndexUpdates a of [] -> [] l -> ["GlobalSecondaryIndexUpdates" .= l] ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-1.hs0000644000000000000000000000045507346545000024635 0ustar0000000000000000instance A.ToJSON UpdateTable where toJSON a = A.object $ "TableName" .= updateTableName a : "ProvisionedThroughput" .= updateProvisionedThroughput a : case updateGlobalSecondaryIndexUpdates a of [] -> [] l -> [ "GlobalSecondaryIndexUpdates" .= l ] ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-2-out.hs0000644000000000000000000000026607346545000025443 0ustar0000000000000000-- A list of the element and all its parents up to the root node. getPath tree t = t : case Map.lookup (getId t) tree of Nothing -> [] Just parent -> getPath tree parent ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-2.hs0000644000000000000000000000030207346545000024625 0ustar0000000000000000-- A list of the element and all its parents up to the root node. getPath tree t = t : case Map.lookup (getId t) tree of Nothing -> [] Just parent -> getPath tree parent ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-3-out.hs0000644000000000000000000000045507346545000025444 0ustar0000000000000000foo = reportSDoc "tc.cc" 30 $ sep $ do (prettyTCM q <+> " before compilation") : do map (prettyTCM . map unArg . clPats) cls foo = reportSDoc "tc.cc" 30 $ sep $ do (prettyTCM q <+> " before compilation") : do map (prettyTCM . map unArg . clPats) cls ormolu-0.1.2.0/data/examples/declaration/value/function/list-notation-3.hs0000644000000000000000000000043307346545000024633 0ustar0000000000000000foo = reportSDoc "tc.cc" 30 $ sep $ do (prettyTCM q <+> " before compilation") : do map (prettyTCM . map unArg . clPats) cls foo = reportSDoc "tc.cc" 30 $ sep $ do (prettyTCM q <+> " before compilation") : do map (prettyTCM . map unArg . clPats) cls ormolu-0.1.2.0/data/examples/declaration/value/function/multi-way-if-out.hs0000644000000000000000000000030307346545000025014 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} foo x = if | x == 5 -> 5 bar x y = if | x > y -> x | x < y -> y | otherwise -> x baz = if | p -> f | otherwise -> g x ormolu-0.1.2.0/data/examples/declaration/value/function/multi-way-if.hs0000644000000000000000000000026607346545000024217 0ustar0000000000000000{-# LANGUAGE MultiWayIf #-} foo x = if | x == 5 -> 5 bar x y = if | x > y -> x | x < y -> y | otherwise -> x baz = if | p -> f | otherwise -> g x ormolu-0.1.2.0/data/examples/declaration/value/function/multiline-arguments-out.hs0000644000000000000000000000012607346545000026500 0ustar0000000000000000foo :: Int -> Int -> Int -> Int foo (Foo g o) ( Bar x y ) z = x ormolu-0.1.2.0/data/examples/declaration/value/function/multiline-arguments.hs0000644000000000000000000000011107346545000025665 0ustar0000000000000000foo :: Int -> Int -> Int -> Int foo (Foo g o) (Bar x y) z = x ormolu-0.1.2.0/data/examples/declaration/value/function/multiple-guards-out.hs0000644000000000000000000000027007346545000025611 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/multiple-guards.hs0000644000000000000000000000026307346545000025006 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/multiple-matches-out.hs0000644000000000000000000000005007346545000025744 0ustar0000000000000000foo :: Int -> Int foo 5 = 10 foo _ = 12 ormolu-0.1.2.0/data/examples/declaration/value/function/multiple-matches.hs0000644000000000000000000000005007346545000025137 0ustar0000000000000000foo :: Int -> Int foo 5 = 10 foo _ = 12 ormolu-0.1.2.0/data/examples/declaration/value/function/negation-out.hs0000644000000000000000000000010107346545000024270 0ustar0000000000000000foo :: Int foo = (-2) bar :: Int bar = -2 baz :: Int baz = - 2 ormolu-0.1.2.0/data/examples/declaration/value/function/negation.hs0000644000000000000000000000010107346545000023463 0ustar0000000000000000foo :: Int foo = (-2) bar :: Int bar = -2 baz :: Int baz = - 2 ormolu-0.1.2.0/data/examples/declaration/value/function/newline-single-line-body-out.hs0000644000000000000000000000036207346545000027275 0ustar0000000000000000function :: Int -> Int function a = aReallyLongFunctionNameThatShouldStayOnThisLineToAvoidOverflowing 10000 a function' :: String -> String function' s = case s of "ThisString" -> -- And a comment here is okay "Yay" _ -> "Boo" ormolu-0.1.2.0/data/examples/declaration/value/function/newline-single-line-body.hs0000644000000000000000000000037007346545000026467 0ustar0000000000000000function :: Int -> Int function a = aReallyLongFunctionNameThatShouldStayOnThisLineToAvoidOverflowing 10000 a function' :: String -> String function' s = case s of "ThisString" -> -- And a comment here is okay "Yay" _ -> "Boo" ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-0-out.hs0000644000000000000000000000030707346545000026307 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-0.hs0000644000000000000000000000031107346545000025475 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-1-out.hs0000644000000000000000000000027607346545000026315 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-1.hs0000644000000000000000000000030007346545000025474 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-2-out.hs0000644000000000000000000000007707346545000026315 0ustar0000000000000000x = y ++ f g -- commentA -- commentB -- commentC ormolu-0.1.2.0/data/examples/declaration/value/function/operator-comments-2.hs0000644000000000000000000000007607346545000025507 0ustar0000000000000000x = y ++ -- commentA -- commentB f g -- commentC ormolu-0.1.2.0/data/examples/declaration/value/function/operator-sections-out.hs0000644000000000000000000000016507346545000026156 0ustar0000000000000000foo = (0 +) bar = (<> "hello") baz = ( 1 * 2 + ) ( * 3 ^ 5 ) quux = (,) <$> foo <$> bar ormolu-0.1.2.0/data/examples/declaration/value/function/operator-sections.hs0000644000000000000000000000015707346545000025352 0ustar0000000000000000foo = (0 +) bar = ( <> "hello" ) baz = ( 1 * 2 + ) ( * 3 ^ 5) quux = (,) <$> foo <$> bar ormolu-0.1.2.0/data/examples/declaration/value/function/operators-0-out.hs0000644000000000000000000000005607346545000024650 0ustar0000000000000000a = b & c .~ d & e %~ f g ormolu-0.1.2.0/data/examples/declaration/value/function/operators-0.hs0000644000000000000000000000005407346545000024041 0ustar0000000000000000a = b & c .~ d & e %~ f g ormolu-0.1.2.0/data/examples/declaration/value/function/operators-1-out.hs0000644000000000000000000000004007346545000024642 0ustar0000000000000000foo = f . g =<< h . i ormolu-0.1.2.0/data/examples/declaration/value/function/operators-1.hs0000644000000000000000000000003407346545000024040 0ustar0000000000000000foo = f . g =<< h . i ormolu-0.1.2.0/data/examples/declaration/value/function/operators-2-out.hs0000644000000000000000000000007107346545000024647 0ustar0000000000000000foo n | x || y && z || n ** x || x && n = 42 ormolu-0.1.2.0/data/examples/declaration/value/function/operators-2.hs0000644000000000000000000000007507346545000024046 0ustar0000000000000000foo n | x || y && z || n ** x || x && n = 42 ormolu-0.1.2.0/data/examples/declaration/value/function/operators-3-out.hs0000644000000000000000000000012007346545000024643 0ustar0000000000000000foo = op <> n <+> colon <+> prettySe <+> text "=" <+> prettySe <> text sc ormolu-0.1.2.0/data/examples/declaration/value/function/operators-3.hs0000644000000000000000000000012007346545000024036 0ustar0000000000000000foo = op <> n <+> colon <+> prettySe <+> text "=" <+> prettySe <> text sc ormolu-0.1.2.0/data/examples/declaration/value/function/operators-4-out.hs0000644000000000000000000000012707346545000024653 0ustar0000000000000000foo = line <> bindingOf <+> text "=" <+> tPretty <+> colon <+> align <> prettyPs ormolu-0.1.2.0/data/examples/declaration/value/function/operators-4.hs0000644000000000000000000000012707346545000024046 0ustar0000000000000000foo = line <> bindingOf <+> text "=" <+> tPretty <+> colon <+> align <> prettyPs ormolu-0.1.2.0/data/examples/declaration/value/function/operators-5-out.hs0000644000000000000000000000006007346545000024650 0ustar0000000000000000foo = map bar $ [ baz ] ++ quux ormolu-0.1.2.0/data/examples/declaration/value/function/operators-5.hs0000644000000000000000000000005207346545000024044 0ustar0000000000000000foo = map bar $ [ baz ] ++ quux ormolu-0.1.2.0/data/examples/declaration/value/function/operators-6-out.hs0000644000000000000000000000026707346545000024662 0ustar0000000000000000type PermuteRef = "a" :> ( "b" :> "c" :> End :<|> "c" :> "b" :> End ) :<|> "b" :> ( "a" :> "c" :> End :<|> "c" :> "a" :> End ) ormolu-0.1.2.0/data/examples/declaration/value/function/operators-6.hs0000644000000000000000000000030607346545000024047 0ustar0000000000000000type PermuteRef = "a" :> ( "b" :> "c" :> End :<|> "c" :> "b" :> End ) :<|> "b" :> ( "a" :> "c" :> End :<|> "c" :> "a" :> End ) ormolu-0.1.2.0/data/examples/declaration/value/function/overindentation-out.hs0000644000000000000000000000026707346545000025711 0ustar0000000000000000reallyincrediblyLongName = f a A { reallyincrediblyLongName = f a A { reallyincrediblyLongName } } ormolu-0.1.2.0/data/examples/declaration/value/function/overindentation.hs0000644000000000000000000000022307346545000025074 0ustar0000000000000000reallyincrediblyLongName = f a A { reallyincrediblyLongName = f a A { reallyincrediblyLongName } } ormolu-0.1.2.0/data/examples/declaration/value/function/overloaded-labels-out.hs0000644000000000000000000000010707346545000026056 0ustar0000000000000000{-# LANGUAGE OverloadedLabels #-} foo = #field bar = (#this) (#that) ormolu-0.1.2.0/data/examples/declaration/value/function/overloaded-labels.hs0000644000000000000000000000011007346545000025243 0ustar0000000000000000{-# LANGUAGE OverloadedLabels #-} foo = #field bar = (#this ) ( #that) ormolu-0.1.2.0/data/examples/declaration/value/function/parallel-comprehensions-complex-out.hs0000644000000000000000000000111007346545000030760 0ustar0000000000000000baz 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 ] ormolu-0.1.2.0/data/examples/declaration/value/function/parallel-comprehensions-complex.hs0000644000000000000000000000151207346545000030161 0ustar0000000000000000baz 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 ] ormolu-0.1.2.0/data/examples/declaration/value/function/parallel-comprehensions-single-line-out.hs0000644000000000000000000000016607346545000031531 0ustar0000000000000000foo 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] ormolu-0.1.2.0/data/examples/declaration/value/function/parallel-comprehensions-single-line.hs0000644000000000000000000000014507346545000030721 0ustar0000000000000000foo 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 ] ormolu-0.1.2.0/data/examples/declaration/value/function/parens-out.hs0000644000000000000000000000003007346545000023755 0ustar0000000000000000f = p (do foo; bar) baz ormolu-0.1.2.0/data/examples/declaration/value/function/parens.hs0000644000000000000000000000003007346545000023150 0ustar0000000000000000f = p (do foo; bar) baz ormolu-0.1.2.0/data/examples/declaration/value/function/parenthesis-lhs-out.hs0000644000000000000000000000017307346545000025606 0ustar0000000000000000(!=!) 2 y = 1 x !=! y = 2 x ?=? [] = 123 (?=?) x (_ : []) = 456 x ?=? _ = f x x where f x 7 = 789 x `f` _ = 101 ormolu-0.1.2.0/data/examples/declaration/value/function/parenthesis-lhs.hs0000644000000000000000000000020307346545000024773 0ustar0000000000000000(!=!) 2 y = 1 x !=! y = 2 x ?=? [] = 123 (?=?) x (_:[]) = 456 x ?=? _ = f x x where f x 7 = 789 x `f` _ = 101 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/0000755000000000000000000000000007346545000023010 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/as-pattern-out.hs0000644000000000000000000000010507346545000026223 0ustar0000000000000000main = case [1] of xs@(x : _) -> print (x, xs) xs@[] -> print xs ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/as-pattern.hs0000644000000000000000000000010507346545000025416 0ustar0000000000000000main = case [1] of xs @ (x:_) -> print (x, xs) xs@[] -> print xs ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/famous-cardano-pattern-out.hs0000644000000000000000000000026207346545000030523 0ustar0000000000000000( getNodeSettingsR :<|> getNodeInfoR :<|> getNextUpdateR :<|> restartNodeR ) :<|> ( getUtxoR :<|> getConfirmedProposalsR ) = client nodeV1Api ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/famous-cardano-pattern.hs0000644000000000000000000000024007346545000027712 0ustar0000000000000000( getNodeSettingsR :<|> getNodeInfoR :<|> getNextUpdateR :<|> restartNodeR ):<|>( getUtxoR :<|> getConfirmedProposalsR ) = client nodeV1Api ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/multiline-case-pattern-out.hs0000644000000000000000000000041007346545000030532 0ustar0000000000000000readerBench 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/multiline-case-pattern.hs0000644000000000000000000000037207346545000027734 0ustar0000000000000000readerBench 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/n-plus-k-pattern-out.hs0000644000000000000000000000022607346545000027272 0ustar0000000000000000{-# LANGUAGE NPlusKPatterns #-} singleline :: Int singleline (n + 1) = n multiline :: Int multiline ( n + 1 ) = n n :: Int (n + 1) = 3 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/n-plus-k-pattern.hs0000644000000000000000000000021007346545000026456 0ustar0000000000000000{-# LANGUAGE NPlusKPatterns #-} singleline :: Int singleline (n + 1) = n multiline :: Int multiline(n + 1) = n n :: Int (n + 1) = 3 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/pattern-bind-out.hs0000644000000000000000000000015407346545000026540 0ustar0000000000000000foo = bar where Foo bar baz = quux Baz quux = zoo foo = bar where Foo bar baz = quux ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/pattern-bind.hs0000644000000000000000000000015107346545000025730 0ustar0000000000000000foo = bar where Foo bar baz = quux Baz quux = zoo foo = bar where Foo bar baz = quux ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/quasi-quotes-pattern-out.hs0000644000000000000000000000024507346545000030265 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} singleline :: () singleline [yamlQQ|something|] = () multiline :: () multiline = case y of [yamlQQ| name: John Doe age: 23 |] -> () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/quasi-quotes-pattern.hs0000644000000000000000000000024607346545000027461 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} singleline :: () singleline [yamlQQ|something|] = () multiline :: () multiline = case y of [yamlQQ| name: John Doe age: 23 |] -> () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/record-patterns-out.hs0000644000000000000000000000041107346545000027261 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/record-patterns.hs0000644000000000000000000000040107346545000026453 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/sig-pattern-out.hs0000644000000000000000000000007507346545000026410 0ustar0000000000000000f = do x :: a <- g f = do (x, y) :: (a, b) <- g ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/sig-pattern.hs0000644000000000000000000000010107346545000025571 0ustar0000000000000000f = do x :: a <- g f = do (x, y) :: (a, b) <- g ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/splice-pattern-out.hs0000644000000000000000000000027007346545000027102 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} singleLine = case () of $x -> () $(y "something") -> () multiline = case () of $( x + y ) -> () $( y "something" ) -> () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/splice-pattern.hs0000644000000000000000000000025207346545000026275 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} singleLine = case () of $x -> () $(y "something") -> () multiline = case () of $(x + y) -> () $(y "something") -> () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/strictness-out.hs0000644000000000000000000000006007346545000026346 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} !a = () ~b = () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/strictness.hs0000644000000000000000000000005707346545000025547 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} !a = () ~b = () ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/unboxed-sum-pattern-out.hs0000644000000000000000000000050507346545000030072 0ustar0000000000000000{-# 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 #) ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/unboxed-sum-pattern.hs0000644000000000000000000000047207346545000027270 0ustar0000000000000000{-# 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 #) ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/view-pattern-out.hs0000644000000000000000000000031607346545000026576 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pattern/view-pattern.hs0000644000000000000000000000033407346545000025771 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/declaration/value/function/pragmas-out.hs0000644000000000000000000000022407346545000024124 0ustar0000000000000000sccfoo = {-# SCC foo #-} 1 sccbar = {-# SCC "barbaz" #-} "hello" corefoo = {-# CORE "foo" #-} 1 corebar = {-# CORE "bar baz" #-} "hello" ormolu-0.1.2.0/data/examples/declaration/value/function/pragmas.hs0000644000000000000000000000021407346545000023316 0ustar0000000000000000sccfoo = {-# SCC foo#-} 1 sccbar = {-# SCC "barbaz"#-} "hello" corefoo = {-# CORE "foo"#-} 1 corebar = {-# CORE "bar baz"#-} "hello" ormolu-0.1.2.0/data/examples/declaration/value/function/prefix-out.hs0000644000000000000000000000002207346545000023763 0ustar0000000000000000foo x y = (+) x y ormolu-0.1.2.0/data/examples/declaration/value/function/prefix.hs0000644000000000000000000000002207346545000023156 0ustar0000000000000000foo x y = (+) x y ormolu-0.1.2.0/data/examples/declaration/value/function/quasi-quotes-out.hs0000644000000000000000000000025007346545000025131 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} singleline :: Value singleline = [yamlQQ|something|] multiline :: Value multiline = [yamlQQ| name: John Doe age: 23 something: foo |] ormolu-0.1.2.0/data/examples/declaration/value/function/quasi-quotes.hs0000644000000000000000000000024507346545000024330 0ustar0000000000000000{-# LANGUAGE QuasiQuotes #-} singleline :: Value singleline = [yamlQQ|something|] multiline :: Value multiline = [yamlQQ| name: John Doe age: 23 something: foo |] ormolu-0.1.2.0/data/examples/declaration/value/function/simple-out.hs0000644000000000000000000000002307346545000023760 0ustar0000000000000000bar x = x baz = x ormolu-0.1.2.0/data/examples/declaration/value/function/simple.hs0000644000000000000000000000002207346545000023152 0ustar0000000000000000bar x = x baz = x ormolu-0.1.2.0/data/examples/declaration/value/function/splice-out.hs0000644000000000000000000000016107346545000023751 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} bar = $bar bar' = $(bar "something") baz = $$baz baz' = $$(baz "something") ormolu-0.1.2.0/data/examples/declaration/value/function/splice.hs0000644000000000000000000000016107346545000023144 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} bar = $bar bar' = $(bar "something") baz = $$baz baz' = $$(baz "something") ormolu-0.1.2.0/data/examples/declaration/value/function/static-pointers-out.hs0000644000000000000000000000032607346545000025625 0ustar0000000000000000{-# LANGUAGE StaticPointers #-} foo :: StaticPtr Int foo = static 5 bar :: StaticPtr [Int] bar = static [ 1, 2, 3 ] baz :: StaticPtr Bool baz = static ( fun 1 2 ) ormolu-0.1.2.0/data/examples/declaration/value/function/static-pointers.hs0000644000000000000000000000031707346545000025020 0ustar0000000000000000{-# LANGUAGE StaticPointers #-} foo :: StaticPtr Int foo = static 5 bar :: StaticPtr [Int] bar = static [ 1 , 2, 3 ] baz :: StaticPtr Bool baz = static (fun 1 2) ormolu-0.1.2.0/data/examples/declaration/value/function/strings-out.hs0000644000000000000000000000013707346545000024166 0ustar0000000000000000{-# LANGUAGE MagicHash #-} foo = "foobar" bar = "foo\&barbaz" baz = "foo\ \bar\ \baz" ormolu-0.1.2.0/data/examples/declaration/value/function/strings.hs0000644000000000000000000000014607346545000023361 0ustar0000000000000000{-# LANGUAGE MagicHash #-} foo = "foobar" bar = "foo\&bar\ \baz" baz = "foo\ \bar\ \baz" ormolu-0.1.2.0/data/examples/declaration/value/function/tricky-parens-out.hs0000644000000000000000000000006007346545000025263 0ustar0000000000000000handleStuff = ( let foo = foo in foo ) ormolu-0.1.2.0/data/examples/declaration/value/function/tricky-parens.hs0000644000000000000000000000006007346545000024456 0ustar0000000000000000handleStuff = ( let foo = foo in foo ) ormolu-0.1.2.0/data/examples/declaration/value/function/tuple-sections-out.hs0000644000000000000000000000011607346545000025450 0ustar0000000000000000{-# LANGUAGE TupleSections #-} foo = (,2) bar = (,5,) baz = (,,5,6,7,,,) ormolu-0.1.2.0/data/examples/declaration/value/function/tuple-sections.hs0000644000000000000000000000012707346545000024645 0ustar0000000000000000{-# LANGUAGE TupleSections #-} foo = (,2) bar = (,5,) baz = ( ,,5,6, 7,,, ) ormolu-0.1.2.0/data/examples/declaration/value/function/tuples-out.hs0000644000000000000000000000017707346545000024015 0ustar0000000000000000foo = (1, 2, 3) bar = ( 1, 2, 3 ) handleStuff = ( let foo = foo in foo, let bar = bar in bar ) ormolu-0.1.2.0/data/examples/declaration/value/function/tuples.hs0000644000000000000000000000017707346545000023210 0ustar0000000000000000foo = ( 1,2,3 ) bar = ( 1, 2, 3 ) handleStuff = ( let foo = foo in foo , let bar = bar in bar ) ormolu-0.1.2.0/data/examples/declaration/value/function/type-applications-and-splice-out.hs0000644000000000000000000000015707346545000030161 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} staticKey name = [|sing @ $(symFQN name)|] ormolu-0.1.2.0/data/examples/declaration/value/function/type-applications-and-splice.hs0000644000000000000000000000016107346545000027347 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} staticKey name = [| sing @ $(symFQN name) |] ormolu-0.1.2.0/data/examples/declaration/value/function/type-applications-out.hs0000644000000000000000000000033707346545000026144 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} foo = f @String a b c bar = f @(Maybe Int) a b baz = f @Int @String a b goo = hash @(HASH TPraosStandardCrypto) @ByteString "And the lamb lies down on Broadway" ormolu-0.1.2.0/data/examples/declaration/value/function/type-applications.hs0000644000000000000000000000031707346545000025335 0ustar0000000000000000{-# LANGUAGE TypeApplications #-} foo = f @String a b c bar = f @(Maybe Int) a b baz = f @Int @String a b goo = hash @(HASH TPraosStandardCrypto) @ByteString "And the lamb lies down on Broadway" ormolu-0.1.2.0/data/examples/declaration/value/function/typed-expressions-out.hs0000644000000000000000000000006707346545000026204 0ustar0000000000000000foo x = x :: Int bar x = Just x :: Maybe String ormolu-0.1.2.0/data/examples/declaration/value/function/typed-expressions.hs0000644000000000000000000000006007346545000025370 0ustar0000000000000000foo x = x::Int bar x = Just x :: Maybe String ormolu-0.1.2.0/data/examples/declaration/value/function/typed-hole-out.hs0000644000000000000000000000006507346545000024547 0ustar0000000000000000foo = 1 `_` 2 bar = 1 `_a` 2 baz = _ `something` _ ormolu-0.1.2.0/data/examples/declaration/value/function/typed-hole.hs0000644000000000000000000000006507346545000023742 0ustar0000000000000000foo = 1 `_` 2 bar = 1 `_a` 2 baz = _ `something` _ ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-string-lit-out.hs0000644000000000000000000000005407346545000026231 0ustar0000000000000000{-# LANGUAGE MagicHash #-} main = new "p"# ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-string-lit.hs0000644000000000000000000000005407346545000025424 0ustar0000000000000000{-# LANGUAGE MagicHash #-} main = new "p"# ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-sums-out.hs0000644000000000000000000000015307346545000025124 0ustar0000000000000000{-# LANGUAGE UnboxedSums #-} foo = (# 1 | #) bar = (# | | 2 | #) baz = (# | | | 10 | | | | | #) ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-sums.hs0000644000000000000000000000014307346545000024316 0ustar0000000000000000{-# LANGUAGE UnboxedSums #-} foo = (# 1 | #) bar = (# | |2| #) baz = (# | | | 10 | | | | | #) ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-tuples-out.hs0000644000000000000000000000013107346545000025445 0ustar0000000000000000{-# LANGUAGE UnboxedTuples #-} foo = (# 1, 2, 3 #) bar = (# 1, 2, 3 #) ormolu-0.1.2.0/data/examples/declaration/value/function/unboxed-tuples.hs0000644000000000000000000000012207346545000024640 0ustar0000000000000000{-# LANGUAGE UnboxedTuples #-} foo = (# 1,2,3 #) bar = (# 1, 2, 3 #) ormolu-0.1.2.0/data/examples/declaration/value/function/where-nested-out.hs0000644000000000000000000000027107346545000025066 0ustar0000000000000000foo = 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 ormolu-0.1.2.0/data/examples/declaration/value/function/where-nested.hs0000644000000000000000000000030007346545000024252 0ustar0000000000000000foo = 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 } } ormolu-0.1.2.0/data/examples/declaration/value/function/where-out.hs0000644000000000000000000000034007346545000023603 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/function/where.hs0000644000000000000000000000034007346545000022776 0ustar0000000000000000foo :: 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 ormolu-0.1.2.0/data/examples/declaration/value/other/0000755000000000000000000000000007346545000020627 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/other/comments-get-before-op-out.hs0000644000000000000000000000034007346545000026243 0ustar0000000000000000main :: IO () main = do migrateSchema [ migration1, migration1, migration3 -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Data ] `finally` Log.close ormolu-0.1.2.0/data/examples/declaration/value/other/comments-get-before-op.hs0000644000000000000000000000037607346545000025447 0ustar0000000000000000main :: IO () main = do migrateSchema [ migration1 , migration1 , migration3 -- When adding migrations here, don't forget to update -- 'schemaVersion' in Galley.Data ] `finally` Log.close ormolu-0.1.2.0/data/examples/declaration/value/other/line-multi-line-out.hs0000644000000000000000000000007207346545000024773 0ustar0000000000000000x :: [Int] x = [ 1, 2, somethingSomething 3 ] ormolu-0.1.2.0/data/examples/declaration/value/other/line-multi-line.hs0000644000000000000000000000007007346545000024164 0ustar0000000000000000x :: [Int] x = [ 1 , 2 , somethingSomething 3 ] ormolu-0.1.2.0/data/examples/declaration/value/other/line-single-line-out.hs0000644000000000000000000000003107346545000025115 0ustar0000000000000000x :: [Int] x = [1, 2, 3] ormolu-0.1.2.0/data/examples/declaration/value/other/line-single-line.hs0000644000000000000000000000002707346545000024315 0ustar0000000000000000x :: [Int] x = [1,2,3] ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/0000755000000000000000000000000007346545000023060 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/bidirectional-out.hs0000644000000000000000000000054407346545000027034 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/bidirectional.hs0000644000000000000000000000056507346545000026232 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional-out.hs0000644000000000000000000000041207346545000031357 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/explicitely-bidirectional.hs0000644000000000000000000000040007346545000030547 0ustar0000000000000000{-# 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) ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/unidirectional-out.hs0000644000000000000000000000047107346545000027234 0ustar0000000000000000{-# 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" ormolu-0.1.2.0/data/examples/declaration/value/pattern-synonyms/unidirectional.hs0000644000000000000000000000046307346545000026430 0ustar0000000000000000{-# 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" ormolu-0.1.2.0/data/examples/declaration/warning/0000755000000000000000000000000007346545000020037 5ustar0000000000000000ormolu-0.1.2.0/data/examples/declaration/warning/warning-multiline-out.hs0000644000000000000000000000016207346545000024644 0ustar0000000000000000{-# WARNING test, foo [ "These are bad functions", "Really bad!" ] #-} test :: IO () test = pure () ormolu-0.1.2.0/data/examples/declaration/warning/warning-multiline.hs0000644000000000000000000000014407346545000024037 0ustar0000000000000000{-# WArNING test, foo ["These are bad functions", "Really bad!"] #-} test :: IO () test = pure () ormolu-0.1.2.0/data/examples/declaration/warning/warning-single-line-out.hs0000644000000000000000000000047107346545000025053 0ustar0000000000000000{-# 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." #-} ormolu-0.1.2.0/data/examples/declaration/warning/warning-single-line.hs0000644000000000000000000000050207346545000024241 0ustar0000000000000000{-# 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." #-} ormolu-0.1.2.0/data/examples/import/0000755000000000000000000000000007346545000015417 5ustar0000000000000000ormolu-0.1.2.0/data/examples/import/comments-inside-imports-out.hs0000644000000000000000000000011107346545000023342 0ustar0000000000000000-- x import qualified -- x Bar import qualified -- x Baz import Foo ormolu-0.1.2.0/data/examples/import/comments-inside-imports.hs0000644000000000000000000000011707346545000022543 0ustar0000000000000000import -- x Foo import -- x qualified Bar import qualified -- x Baz ormolu-0.1.2.0/data/examples/import/comments-per-import-out.hs0000644000000000000000000000006607346545000022503 0ustar0000000000000000-- (1) import Bar -- (2) import Baz -- (3) import Foo ormolu-0.1.2.0/data/examples/import/comments-per-import.hs0000644000000000000000000000006607346545000021676 0ustar0000000000000000import Foo -- (1) import Bar -- (2) import Baz -- (3) ormolu-0.1.2.0/data/examples/import/deduplication-bug-out.hs0000644000000000000000000000025007346545000022154 0ustar0000000000000000import Foo1 (Bar1 (..), Baz1) import Foo2 (Bar2 (..), Baz2) import Foo3 (Bar3 (x1, x2, x3)) import Foo4 (Bar4 (x1, x2)) import Foo5 (Bar5 (x1)) import Foo6 (Bar6 (..)) ormolu-0.1.2.0/data/examples/import/deduplication-bug.hs0000644000000000000000000000031507346545000021351 0ustar0000000000000000import Foo1 (Bar1, Baz1, Bar1(..)) import Foo2 (Bar2(..), Baz2, Bar2) import Foo3 (Bar3(x1,x3), Bar3(x1, x2)) import Foo4 (Bar4(x1), Bar4(x2)) import Foo5 (Bar5, Bar5(x1)) import Foo6 (Bar6(x1), Bar6(..)) ormolu-0.1.2.0/data/examples/import/explicit-imports-out.hs0000644000000000000000000000031207346545000022070 0ustar0000000000000000import qualified MegaModule as M ( Either, Maybe (Just, Nothing), MaybeT (..), Monad (return, (>>), (>>=)), MonadBaseControl, join, liftIO, void, (<<<), (>>>), ) ormolu-0.1.2.0/data/examples/import/explicit-imports-with-comments-out.hs0000644000000000000000000000014407346545000024667 0ustar0000000000000000import qualified MegaModule as M ( -- (1) -- (2) Either, -- (3) (<<<), (>>>), ) ormolu-0.1.2.0/data/examples/import/explicit-imports-with-comments.hs0000644000000000000000000000013107346545000024056 0ustar0000000000000000import qualified MegaModule as M ( (>>>) -- (1) , (<<<) -- (2) , Either -- (3) ) ormolu-0.1.2.0/data/examples/import/explicit-imports.hs0000644000000000000000000000023607346545000021270 0ustar0000000000000000import qualified MegaModule as M ((>>>), MonadBaseControl, void, MaybeT(..), join, Maybe(Nothing, Just), liftIO, Either, (<<<), Monad(return, (>>=), (>>))) ormolu-0.1.2.0/data/examples/import/explicit-prelude-out.hs0000644000000000000000000000004507346545000022036 0ustar0000000000000000import Aaa import Zzz import Prelude ormolu-0.1.2.0/data/examples/import/explicit-prelude.hs0000644000000000000000000000004507346545000021231 0ustar0000000000000000import Aaa import Prelude import Zzz ormolu-0.1.2.0/data/examples/import/merging-0-out.hs0000644000000000000000000000006107346545000020342 0ustar0000000000000000import Foo import Foo (bar, foo) import Foo as F ormolu-0.1.2.0/data/examples/import/merging-0.hs0000644000000000000000000000007507346545000017542 0ustar0000000000000000import Foo import Foo (foo) import Foo (bar) import Foo as F ormolu-0.1.2.0/data/examples/import/merging-1-out.hs0000644000000000000000000000006307346545000020345 0ustar0000000000000000import "bar" Foo (bar) import "foo" Foo (baz, foo) ormolu-0.1.2.0/data/examples/import/merging-1.hs0000644000000000000000000000010507346545000017535 0ustar0000000000000000import "foo" Foo (foo) import "bar" Foo (bar) import "foo" Foo (baz) ormolu-0.1.2.0/data/examples/import/merging-2-out.hs0000644000000000000000000000010107346545000020337 0ustar0000000000000000import Foo hiding (bar4, foo2) import qualified Foo (bar3, foo1) ormolu-0.1.2.0/data/examples/import/merging-2.hs0000644000000000000000000000015207346545000017540 0ustar0000000000000000import qualified Foo (foo1) import Foo hiding (foo2) import qualified Foo (bar3) import Foo hiding (bar4) ormolu-0.1.2.0/data/examples/import/misc-out.hs0000644000000000000000000000020707346545000017512 0ustar0000000000000000import A hiding ( foobarbazqux, ) import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f) import Name hiding () ormolu-0.1.2.0/data/examples/import/misc.hs0000644000000000000000000000035607346545000016712 0ustar0000000000000000import 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) ormolu-0.1.2.0/data/examples/import/nested-explicit-imports-out.hs0000644000000000000000000000020607346545000023352 0ustar0000000000000000import qualified MegaModule as M ( Either, Monad ( return, (>>), (>>=) ), (<<<), (>>>), ) ormolu-0.1.2.0/data/examples/import/nested-explicit-imports.hs0000644000000000000000000000012707346545000022547 0ustar0000000000000000import qualified MegaModule as M ((>>>), Either, (<<<), Monad( return, (>>=), (>>))) ormolu-0.1.2.0/data/examples/import/qualified-post-out.hs0000644000000000000000000000022707346545000021507 0ustar0000000000000000{-# LANGUAGE ImportQualifiedPost #-} import Data.Text qualified (a, b, c) import Data.Text qualified hiding (a, b, c) import Data.Text qualified as T ormolu-0.1.2.0/data/examples/import/qualified-post.hs0000644000000000000000000000022707346545000020702 0ustar0000000000000000{-# LANGUAGE ImportQualifiedPost #-} import qualified Data.Text as T import qualified Data.Text (a, c, b) import Data.Text qualified hiding (c, b, a) ormolu-0.1.2.0/data/examples/import/qualified-prelude-out.hs0000644000000000000000000000011107346545000022152 0ustar0000000000000000module P where import Prelude hiding (id, (.)) import qualified Prelude ormolu-0.1.2.0/data/examples/import/qualified-prelude.hs0000644000000000000000000000011107346545000021345 0ustar0000000000000000module P where import Prelude hiding (id, (.)) import qualified Prelude ormolu-0.1.2.0/data/examples/import/simple-out.hs0000644000000000000000000000022307346545000020046 0ustar0000000000000000import Data.Text import Data.Text (a, b, c) import Data.Text hiding (a, b, c) import qualified Data.Text (a, b, c) import qualified Data.Text as T ormolu-0.1.2.0/data/examples/import/simple.hs0000644000000000000000000000035507346545000017247 0ustar0000000000000000import 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) import Data.Text (a, b, c, b, a) import Data.Text hiding (c, b, a, b, c) ormolu-0.1.2.0/data/examples/import/sorted-export-list-out.hs0000644000000000000000000000006107346545000022345 0ustar0000000000000000import Linear.Vector (Additive (..), (*^), (^*)) ormolu-0.1.2.0/data/examples/import/sorted-export-list.hs0000644000000000000000000000006107346545000021540 0ustar0000000000000000import Linear.Vector (Additive (..), (*^), (^*)) ormolu-0.1.2.0/data/examples/import/sorted-out.hs0000644000000000000000000000003307346545000020054 0ustar0000000000000000import A import B import C ormolu-0.1.2.0/data/examples/import/sorted.hs0000644000000000000000000000003307346545000017247 0ustar0000000000000000import B import A import C ormolu-0.1.2.0/data/examples/module-header/0000755000000000000000000000000007346545000016620 5ustar0000000000000000ormolu-0.1.2.0/data/examples/module-header/double-dot-with-names-out.hs0000644000000000000000000000032507346545000024071 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/module-header/double-dot-with-names.hs0000644000000000000000000000032007346545000023257 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/module-header/double-shebangs-out.hs0000644000000000000000000000005207346545000023020 0ustar0000000000000000#!/usr/bin/env stack #!/usr/bin/env stack ormolu-0.1.2.0/data/examples/module-header/double-shebangs.hs0000644000000000000000000000005207346545000022213 0ustar0000000000000000#!/usr/bin/env stack #!/usr/bin/env stack ormolu-0.1.2.0/data/examples/module-header/empty-out.hs0000644000000000000000000000000007346545000021105 0ustar0000000000000000ormolu-0.1.2.0/data/examples/module-header/empty.hs0000644000000000000000000000000007346545000020300 0ustar0000000000000000ormolu-0.1.2.0/data/examples/module-header/leading-empty-line-out.hs0000644000000000000000000000052507346545000023447 0ustar0000000000000000-- | -- Module : Text.Megaparsec -- Copyright : © 2015–2019 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable module Main where ormolu-0.1.2.0/data/examples/module-header/leading-empty-line.hs0000644000000000000000000000052507346545000022642 0ustar0000000000000000-- | -- Module : Text.Megaparsec -- Copyright : © 2015–2019 Megaparsec contributors -- © 2007 Paolo Martini -- © 1999–2001 Daan Leijen -- License : FreeBSD -- -- Maintainer : Mark Karpov -- Stability : experimental -- Portability : portable module Main where ormolu-0.1.2.0/data/examples/module-header/multiline-empty-out.hs0000644000000000000000000000003107346545000023111 0ustar0000000000000000module Foo ( ) where ormolu-0.1.2.0/data/examples/module-header/multiline-empty.hs0000644000000000000000000000004007346545000022304 0ustar0000000000000000module Foo ( ) where ormolu-0.1.2.0/data/examples/module-header/multiline-out.hs0000644000000000000000000000006007346545000021757 0ustar0000000000000000module Foo ( foo, bar, baz, ) where ormolu-0.1.2.0/data/examples/module-header/multiline-with-comments-out.hs0000644000000000000000000000054307346545000024561 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/module-header/multiline-with-comments.hs0000644000000000000000000000055007346545000023752 0ustar0000000000000000-- | 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 ormolu-0.1.2.0/data/examples/module-header/multiline.hs0000644000000000000000000000004407346545000021154 0ustar0000000000000000module Foo ( foo, bar, baz) where ormolu-0.1.2.0/data/examples/module-header/multiline2-out.hs0000644000000000000000000000006007346545000022041 0ustar0000000000000000module Foo ( foo, bar, baz, ) where ormolu-0.1.2.0/data/examples/module-header/multiline2.hs0000644000000000000000000000004407346545000021236 0ustar0000000000000000module Foo ( foo, bar, baz) where ormolu-0.1.2.0/data/examples/module-header/named-section-out.hs0000644000000000000000000000021607346545000022506 0ustar0000000000000000module Magic ( -- * Something -- $explanation -- ** Another level foo, bar, ) where -- $explanation -- -- Here it goes. ormolu-0.1.2.0/data/examples/module-header/named-section.hs0000644000000000000000000000021407346545000021677 0ustar0000000000000000module Magic ( -- * Something -- $explanation -- ** Another level foo , bar ) where -- $explanation -- -- Here it goes. ormolu-0.1.2.0/data/examples/module-header/preceding-comment-with-haddock-out.hs0000644000000000000000000000014407346545000025724 0ustar0000000000000000{- Here we go. -} -- | This is the module's Haddock. module Main (main) where main = return () ormolu-0.1.2.0/data/examples/module-header/preceding-comment-with-haddock.hs0000644000000000000000000000014407346545000025117 0ustar0000000000000000{- Here we go. -} -- | This is the module's Haddock. module Main (main) where main = return () ormolu-0.1.2.0/data/examples/module-header/shebang-out.hs0000644000000000000000000000013007346545000021362 0ustar0000000000000000#! /usr/bin/env runhaskell import Prelude main :: IO () main = putStrLn "hello world" ormolu-0.1.2.0/data/examples/module-header/shebang-with-pragmas-out.hs0000644000000000000000000000011107346545000023762 0ustar0000000000000000#!/usr/bin/env stack {-# LANGUAGE OverloadedStrings #-} main = pure () ormolu-0.1.2.0/data/examples/module-header/shebang-with-pragmas.hs0000644000000000000000000000011107346545000023155 0ustar0000000000000000#!/usr/bin/env stack {-# LANGUAGE OverloadedStrings #-} main = pure () ormolu-0.1.2.0/data/examples/module-header/shebang.hs0000644000000000000000000000013007346545000020555 0ustar0000000000000000#! /usr/bin/env runhaskell import Prelude main :: IO () main = putStrLn "hello world" ormolu-0.1.2.0/data/examples/module-header/simple-out.hs0000644000000000000000000000002207346545000021244 0ustar0000000000000000module Main where ormolu-0.1.2.0/data/examples/module-header/simple-with-comments-out.hs0000644000000000000000000000005407346545000024045 0ustar0000000000000000-- | Here we go. module Main where -- Wow. ormolu-0.1.2.0/data/examples/module-header/simple-with-comments.hs0000644000000000000000000000005507346545000023241 0ustar0000000000000000-- | Here we go. module Main where -- Wow. ormolu-0.1.2.0/data/examples/module-header/simple.hs0000644000000000000000000000002207346545000020437 0ustar0000000000000000module Main where ormolu-0.1.2.0/data/examples/module-header/singleline-empty-out.hs0000644000000000000000000000006207346545000023244 0ustar0000000000000000-- | This demonstrates a BUG. module Foo () where ormolu-0.1.2.0/data/examples/module-header/singleline-empty.hs0000644000000000000000000000006207346545000022437 0ustar0000000000000000-- | This demonstrates a BUG. module Foo () where ormolu-0.1.2.0/data/examples/module-header/singleline-out.hs0000644000000000000000000000004107346545000022105 0ustar0000000000000000module Foo (foo, bar, baz) where ormolu-0.1.2.0/data/examples/module-header/singleline.hs0000644000000000000000000000004307346545000021302 0ustar0000000000000000module Foo ( foo, bar, baz ) where ormolu-0.1.2.0/data/examples/module-header/stack-header-0-out.hs0000644000000000000000000000013707346545000022452 0ustar0000000000000000-- stack runhaskell {-# LANGUAGE OverloadedStrings #-} main = return () -- stack runhaskell ormolu-0.1.2.0/data/examples/module-header/stack-header-0.hs0000644000000000000000000000013407346545000021642 0ustar0000000000000000-- stack runhaskell {-# LANGUAGE OverloadedStrings #-} main = return () -- stack runhaskell ormolu-0.1.2.0/data/examples/module-header/stack-header-1-out.hs0000644000000000000000000000016407346545000022453 0ustar0000000000000000#!/usr/bin/env stack -- stack runhaskell {-# LANGUAGE OverloadedStrings #-} main = return () -- stack runhaskell ormolu-0.1.2.0/data/examples/module-header/stack-header-1.hs0000644000000000000000000000016107346545000021643 0ustar0000000000000000#!/usr/bin/env stack -- stack runhaskell {-# LANGUAGE OverloadedStrings #-} main = return () -- stack runhaskell ormolu-0.1.2.0/data/examples/module-header/stack-header-2-out.hs0000644000000000000000000000030607346545000022452 0ustar0000000000000000#!/usr/bin/env stack {- stack script --resolver lts-6.25 --package turtle --package "stm async" --package http-client,http-conduit -} {-# LANGUAGE OverloadedStrings #-} main = return () ormolu-0.1.2.0/data/examples/module-header/stack-header-2.hs0000644000000000000000000000030607346545000021645 0ustar0000000000000000#!/usr/bin/env stack {- stack script --resolver lts-6.25 --package turtle --package "stm async" --package http-client,http-conduit -} {-# LANGUAGE OverloadedStrings #-} main = return () ormolu-0.1.2.0/data/examples/module-header/warning-pragma-list-multiline-out.hs0000644000000000000000000000023407346545000025643 0ustar0000000000000000module Test {-# DEPRECATED [ "This module is deprecated.", "Please use OtherModule instead." ] #-} ( foo, bar, baz, ) where ormolu-0.1.2.0/data/examples/module-header/warning-pragma-list-multiline.hs0000644000000000000000000000020607346545000025035 0ustar0000000000000000module Test {-# DEPRECATED ["This module is deprecated.", "Please use OtherModule instead." ]#-} ( foo , bar , baz ) where ormolu-0.1.2.0/data/examples/module-header/warning-pragma-multiline-out.hs0000644000000000000000000000014007346545000024666 0ustar0000000000000000module Test {-# DEPRECATED "This module is unstable" #-} (foo, bar, baz) where import Blah ormolu-0.1.2.0/data/examples/module-header/warning-pragma-multiline.hs0000644000000000000000000000013607346545000024066 0ustar0000000000000000module Test {-# DEPRECATED "This module is unstable" #-} (foo, bar, baz) where import Blah ormolu-0.1.2.0/data/examples/module-header/warning-pragma-out.hs0000644000000000000000000000011307346545000022666 0ustar0000000000000000module Test {-# WARNING "This module is very internal" #-} where ormolu-0.1.2.0/data/examples/module-header/warning-pragma-singleton-list-out.hs0000644000000000000000000000010007346545000025633 0ustar0000000000000000module Test {-# WARNING "There's only one line here." #-} where ormolu-0.1.2.0/data/examples/module-header/warning-pragma-singleton-list.hs0000644000000000000000000000010607346545000025034 0ustar0000000000000000module Test {-# WArnING ["There's only one line here."] #-} where ormolu-0.1.2.0/data/examples/module-header/warning-pragma.hs0000644000000000000000000000010307346545000022060 0ustar0000000000000000module Test {-# WARNING "This module is very internal" #-} where ormolu-0.1.2.0/data/examples/other/0000755000000000000000000000000007346545000015226 5ustar0000000000000000ormolu-0.1.2.0/data/examples/other/argument-comment-out.hs0000644000000000000000000000022207346545000021645 0ustar0000000000000000foo :: -- | Documentation Int -> Bool foo _ = True foo :: Foo a => -- | Foo Int -> Int foo :: Foo a => -- | Foo Int -> Int ormolu-0.1.2.0/data/examples/other/argument-comment.hs0000644000000000000000000000021307346545000021040 0ustar0000000000000000foo :: Int -- ^ Documentation -> Bool foo _ = True foo :: Foo a => Int -- ^ Foo -> Int foo :: Foo a => Int -- ^ Foo -> Int ormolu-0.1.2.0/data/examples/other/ascii-out.hs0000644000000000000000000000037607346545000017465 0ustar0000000000000000{- ----------------------------------- < What about ASCII art in comments? > ----------------------------------- \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || -} ormolu-0.1.2.0/data/examples/other/ascii.hs0000644000000000000000000000037607346545000016660 0ustar0000000000000000{- ----------------------------------- < What about ASCII art in comments? > ----------------------------------- \ ^__^ \ (oo)\_______ (__)\ )\/\ ||----w | || || -} ormolu-0.1.2.0/data/examples/other/comment-after-preceding-haddock-out.hs0000644000000000000000000000013407346545000024457 0ustar0000000000000000module Main where -- | A -- B type D = E -- | This is 'f' -- * Comment f :: a -> b ormolu-0.1.2.0/data/examples/other/comment-after-preceding-haddock.hs0000644000000000000000000000013407346545000023652 0ustar0000000000000000module Main where -- | A -- B type D = E -- | This is 'f' -- * Comment f :: a -> b ormolu-0.1.2.0/data/examples/other/comment-alignment-out.hs0000644000000000000000000000014307346545000022003 0ustar0000000000000000class Foo a where -- | Foo. foo :: Int -> -- | Something a -- | Bar. bar :: a ormolu-0.1.2.0/data/examples/other/comment-alignment.hs0000644000000000000000000000014207346545000021175 0ustar0000000000000000class Foo a where -- | Foo. foo :: Int -> a -- ^ Something -- | Bar. bar :: a ormolu-0.1.2.0/data/examples/other/comment-before-hanging-out.hs0000644000000000000000000000005307346545000022700 0ustar0000000000000000x = Just -- comment do foo bar ormolu-0.1.2.0/data/examples/other/comment-before-hanging.hs0000644000000000000000000000005307346545000022073 0ustar0000000000000000x = Just -- comment do foo bar ormolu-0.1.2.0/data/examples/other/comment-following-preceding-gap-out.hs0000644000000000000000000000011507346545000024527 0ustar0000000000000000foo = bar where baz = return (quux) -- Foo -- Bar meme = gege ormolu-0.1.2.0/data/examples/other/comment-following-preceding-gap.hs0000644000000000000000000000011507346545000023722 0ustar0000000000000000foo = bar where baz = return (quux) -- Foo -- Bar meme = gege ormolu-0.1.2.0/data/examples/other/comment-glued-together-out.hs0000644000000000000000000000011307346545000022741 0ustar0000000000000000module Main (main) where -- | Foo. -- Bar main :: IO () main = return () ormolu-0.1.2.0/data/examples/other/comment-glued-together.hs0000644000000000000000000000011507346545000022136 0ustar0000000000000000module Main (main) where {- | Foo. -} -- Bar main :: IO () main = return () ormolu-0.1.2.0/data/examples/other/comment-inside-construct-out.hs0000644000000000000000000000023307346545000023322 0ustar0000000000000000xs = [ outer list item, [ inner list first item, inner list second item -- inner list last item commented ], outer list item ] ormolu-0.1.2.0/data/examples/other/comment-inside-construct.hs0000644000000000000000000000023407346545000022516 0ustar0000000000000000xs = [ outer list item, [ inner list first item, inner list second item -- inner list last item commented ], outer list item ] ormolu-0.1.2.0/data/examples/other/comment-multiline-after-out.hs0000644000000000000000000000011107346545000023121 0ustar0000000000000000foo :: -- | start index Int -> -- | length Int -> t a -> t a ormolu-0.1.2.0/data/examples/other/comment-multiline-after.hs0000644000000000000000000000010307346545000022315 0ustar0000000000000000foo :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a ormolu-0.1.2.0/data/examples/other/comment-style-transform-out.hs0000644000000000000000000000043207346545000023177 0ustar0000000000000000-- | -- 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 ormolu-0.1.2.0/data/examples/other/comment-style-transform.hs0000644000000000000000000000040007346545000022365 0ustar0000000000000000{-| 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 ormolu-0.1.2.0/data/examples/other/comment-trailing-space-out.hs0000644000000000000000000000012307346545000022725 0ustar0000000000000000data T = {- some multi-line comment with empty lines -} A ormolu-0.1.2.0/data/examples/other/comment-trailing-space.hs0000644000000000000000000000012307346545000022120 0ustar0000000000000000data T = {- some multi-line comment with empty lines -} A ormolu-0.1.2.0/data/examples/other/comment-two-blocks-out.hs0000644000000000000000000000016607346545000022116 0ustar0000000000000000newNames :: [(String, String)] newNames = let (*) = flip (,) in [ "Control" * "Monad" -- Foo -- Bar ] ormolu-0.1.2.0/data/examples/other/comment-two-blocks.hs0000644000000000000000000000017007346545000021304 0ustar0000000000000000newNames :: [(String, String)] newNames = let (*) = flip (,) in ["Control" * "Monad" -- Foo -- Bar ] ormolu-0.1.2.0/data/examples/other/consequetive-pipe-comments-out.hs0000644000000000000000000000007307346545000023657 0ustar0000000000000000module Main where -- | Foo. -- | Bar. bar :: Int bar = 5 ormolu-0.1.2.0/data/examples/other/consequetive-pipe-comments.hs0000644000000000000000000000007407346545000023053 0ustar0000000000000000module Main where -- | Foo. -- | Bar. bar :: Int bar = 5 ormolu-0.1.2.0/data/examples/other/empty-forall-out.hs0000644000000000000000000000035007346545000021000 0ustar0000000000000000-- Empty foralls are handled correctly in different situations. data D = forall. D Int data G where G :: forall. Int -> G f :: forall. a -> a f x = x type family T x where forall. T x = x {-# RULES "r" r a = () #-} ormolu-0.1.2.0/data/examples/other/empty-forall.hs0000644000000000000000000000035407346545000020177 0ustar0000000000000000-- Empty foralls are handled correctly in different situations. data D = forall. D Int data G where G :: forall. Int -> G f :: forall. a -> a f x = x type family T x where forall. T x = x {-# RULES "r" forall. r a = () #-} ormolu-0.1.2.0/data/examples/other/empty-haddock-out.hs0000644000000000000000000000005307346545000021116 0ustar0000000000000000module Main where -- | foo :: Int foo = 5 ormolu-0.1.2.0/data/examples/other/empty-haddock.hs0000644000000000000000000000005407346545000020312 0ustar0000000000000000module Main where -- | foo :: Int foo = 5 ormolu-0.1.2.0/data/examples/other/following-comment-last-0-out.hs0000644000000000000000000000012107346545000023117 0ustar0000000000000000module Main where -- | Another datatype... data D' -- ^ ...with two docstrings. ormolu-0.1.2.0/data/examples/other/following-comment-last-0.hs0000644000000000000000000000012107346545000022312 0ustar0000000000000000module Main where -- | Another datatype... data D' -- ^ ...with two docstrings. ormolu-0.1.2.0/data/examples/other/following-comment-last-1-out.hs0000644000000000000000000000015407346545000023126 0ustar0000000000000000module Main where -- | Another datatype... data D' deriving (Show) -- ^ ...with two docstrings. -- more ormolu-0.1.2.0/data/examples/other/following-comment-last-1.hs0000644000000000000000000000015407346545000022321 0ustar0000000000000000module Main where -- | Another datatype... data D' deriving (Show) -- ^ ...with two docstrings. -- more ormolu-0.1.2.0/data/examples/other/following-comment-last-2-out.hs0000644000000000000000000000016407346545000023130 0ustar0000000000000000module Main where -- | Another datatype... data D' deriving (Show) -- ^ ...with two docstrings. -- more data B ormolu-0.1.2.0/data/examples/other/following-comment-last-2.hs0000644000000000000000000000016407346545000022323 0ustar0000000000000000module Main where -- | Another datatype... data D' deriving (Show) -- ^ ...with two docstrings. -- more data B ormolu-0.1.2.0/data/examples/other/following-comment-last-3-out.hs0000644000000000000000000000015007346545000023124 0ustar0000000000000000module Main where -- | Another datatype... data D' -- ^ ...with two docstrings. -- even on second line ormolu-0.1.2.0/data/examples/other/following-comment-last-3.hs0000644000000000000000000000015007346545000022317 0ustar0000000000000000module Main where -- | Another datatype... data D' -- ^ ...with two docstrings. -- even on second line ormolu-0.1.2.0/data/examples/other/haddock-sections-out.hs0000644000000000000000000000007707346545000021615 0ustar0000000000000000-- $weird #anchor# -- -- Section 1 -- $normal -- -- Section 2 ormolu-0.1.2.0/data/examples/other/haddock-sections.hs0000644000000000000000000000007707346545000021010 0ustar0000000000000000-- $weird #anchor# -- -- Section 1 -- $normal -- -- Section 2 ormolu-0.1.2.0/data/examples/other/inline-comment-0-out.hs0000644000000000000000000000004007346545000021434 0ustar0000000000000000x = ({-a-} b, c) y = ({-a-} b) ormolu-0.1.2.0/data/examples/other/inline-comment-0.hs0000644000000000000000000000003607346545000020634 0ustar0000000000000000x = ({-a-}b, c) y = ({-a-}b) ormolu-0.1.2.0/data/examples/other/inline-comment-1-out.hs0000644000000000000000000000054607346545000021450 0ustar0000000000000000showPs env ((n, _, Let _ t v) : bs) = " " ++ show n ++ " : " ++ showEnv env ({- normalise ctxt env -} t) ++ " = " ++ showEnv env ({- normalise ctxt env -} v) ++ "\n" ++ showPs env bs showPs env ((n, _, b) : bs) = " " ++ show n ++ " : " ++ showEnv env ({- normalise ctxt env -} (binderTy b)) ++ "\n" ++ showPs env bs ormolu-0.1.2.0/data/examples/other/inline-comment-1.hs0000644000000000000000000000054407346545000020641 0ustar0000000000000000showPs env ((n, _, Let _ t v):bs) = " " ++ show n ++ " : " ++ showEnv env ({- normalise ctxt env -} t) ++ " = " ++ showEnv env ({- normalise ctxt env -} v) ++ "\n" ++ showPs env bs showPs env ((n, _, b):bs) = " " ++ show n ++ " : " ++ showEnv env ({- normalise ctxt env -} (binderTy b)) ++ "\n" ++ showPs env bs ormolu-0.1.2.0/data/examples/other/merging-comments-out.hs0000644000000000000000000000037207346545000021644 0ustar0000000000000000foo 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 ormolu-0.1.2.0/data/examples/other/merging-comments.hs0000644000000000000000000000043507346545000021037 0ustar0000000000000000foo 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 ormolu-0.1.2.0/data/examples/other/multiline-comments-reindent-out.hs0000644000000000000000000000010307346545000024014 0ustar0000000000000000{- And so here we have a multiline comment. Indeed. -} ormolu-0.1.2.0/data/examples/other/multiline-comments-reindent.hs0000644000000000000000000000021107346545000023207 0ustar0000000000000000 {- And so here we have a multiline comment. Indeed. -} ormolu-0.1.2.0/data/examples/other/multiline-forall-out.hs0000644000000000000000000000134707346545000021653 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} -- Multiline foralls are consistent across all declarations data D = forall ( f :: * -> * -> * ) (x :: *) (y :: *). D (f x y) data G where G :: forall ( f :: * -> * -> * ) (x :: *) (y :: *). f x y -> G f :: forall ( f :: * -> * -> * ) (x :: *) (y :: *). f x y -> () f = const () type family T f x y where forall ( f :: * -> * -> * ) (x :: *) (y :: *). T f x y = f x y {-# RULES "r" forall ( f :: * -> * -> * ) (x :: *) (y :: *). r (a :: f x y) = () #-} ormolu-0.1.2.0/data/examples/other/multiline-forall.hs0000644000000000000000000000122707346545000021043 0ustar0000000000000000{-# LANGUAGE RankNTypes, PolyKinds, GADTs, TypeFamilies #-} -- Multiline foralls are consistent across all declarations data D = forall (f :: * -> * -> *) (x :: *) (y :: *) . D (f x y) data G where G :: forall (f :: * -> * -> *) (x :: *) (y :: *) . f x y -> G f :: forall (f :: * -> * -> *) (x :: *) (y :: *) . f x y -> () f = const () type family T f x y where forall (f :: * -> * -> *) (x :: *) (y :: *) . T f x y = f x y {-# RULES "r" forall (f :: * -> * -> *) (x :: *) (y :: *) . r (a :: f x y) = () #-} ormolu-0.1.2.0/data/examples/other/multiple-blank-line-comment-out.hs0000644000000000000000000000013107346545000023667 0ustar0000000000000000module A where a = b [ f {-, -} ] ormolu-0.1.2.0/data/examples/other/multiple-blank-line-comment.hs0000644000000000000000000000012407346545000023064 0ustar0000000000000000module A where a = b [ f {-, -} ] ormolu-0.1.2.0/data/examples/other/overly-indented-out.hs0000644000000000000000000000031607346545000021477 0ustar0000000000000000tagCloudField :: -- | Destination key String -> -- | Smallest font size, in percent Double -> -- | Biggest font size, in percent Double -> -- | Input tags Tags -> -- | Context Context a ormolu-0.1.2.0/data/examples/other/overly-indented.hs0000644000000000000000000000050107346545000020666 0ustar0000000000000000tagCloudField :: String -- ^ Destination key -> Double -- ^ Smallest font size, in percent -> Double -- ^ Biggest font size, in percent -> Tags -- ^ Input tags -> Context a -- ^ Context ormolu-0.1.2.0/data/examples/other/pragma-comments-after-out.hs0000644000000000000000000000023307346545000022556 0ustar0000000000000000{-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} -- TODO: Fix and delete this pragma {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} ormolu-0.1.2.0/data/examples/other/pragma-comments-after.hs0000644000000000000000000000023307346545000021751 0ustar0000000000000000{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- TODO: Fix and delete this pragma {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} ormolu-0.1.2.0/data/examples/other/pragma-comments-out.hs0000644000000000000000000000037707346545000021470 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- TODO This extension is probably too dangerous, remove it. {-# LANGUAGE RecordWildCards #-} -- Avoid warning produced by TH. {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -- | Header comment. module Foo () where ormolu-0.1.2.0/data/examples/other/pragma-comments.hs0000644000000000000000000000040207346545000020650 0ustar0000000000000000-- | Header comment. {-# LANGUAGE OverloadedStrings #-} -- Avoid warning produced by TH. {-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -- TODO This extension is probably too dangerous, remove it. {-# LANGUAGE RecordWildCards #-} module Foo () where ormolu-0.1.2.0/data/examples/other/pragma-no-header-out.hs0000644000000000000000000000012507346545000021474 0ustar0000000000000000{-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ViewPatterns #-} ormolu-0.1.2.0/data/examples/other/pragma-no-header.hs0000644000000000000000000000014107346545000020665 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGuagE ViewPatterns #-} {-# language DataKinds, LambdaCase #-} ormolu-0.1.2.0/data/examples/other/pragma-out.hs0000644000000000000000000000053407346545000017640 0ustar0000000000000000{-# 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 ormolu-0.1.2.0/data/examples/other/pragma-sorting-out.hs0000644000000000000000000000042507346545000021322 0ustar0000000000000000{-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} -- This gap is necessary for stylish Haskell not to re-arrange -- NoMonoLocalBinds before TypeFamilies {-# LANGUAGE NoMonoLocalBinds #-} module Foo ( bar, ) where ormolu-0.1.2.0/data/examples/other/pragma-sorting.hs0000644000000000000000000000043707346545000020520 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NondecreasingIndentation #-} -- This gap is necessary for stylish Haskell not to re-arrange -- NoMonoLocalBinds before TypeFamilies {-# LANGUAGE NoMonoLocalBinds #-} module Foo ( bar ) where ormolu-0.1.2.0/data/examples/other/pragma.hs0000644000000000000000000000055007346545000017031 0ustar0000000000000000-- | 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 ormolu-0.1.2.0/data/examples/other/trailing-whitespace-out.hs0000644000000000000000000000016707346545000022336 0ustar0000000000000000-- Here is a comment with trailing whitespace. foo = 5 {- Block comment with trailing whitespace. Bo. -} bar = 6 ormolu-0.1.2.0/data/examples/other/trailing-whitespace.hs0000644000000000000000000000020107346545000021516 0ustar0000000000000000-- Here is a comment with trailing whitespace. foo = 5 {- Block comment with trailing whitespace. Bo. -} bar = 6 ormolu-0.1.2.0/ormolu.cabal0000644000000000000000000001362607346545000013667 0ustar0000000000000000cabal-version: 1.18 name: ormolu version: 0.1.2.0 license: BSD3 license-file: LICENSE.md maintainer: Mark Karpov tested-with: ghc ==8.6.5 ghc ==8.8.3 ghc ==8.10.1 homepage: https://github.com/tweag/ormolu bug-reports: https://github.com/tweag/ormolu/issues synopsis: A formatter for Haskell source code description: A formatter for Haskell source code. category: Development, Formatting build-type: Simple data-files: data/examples/declaration/annotation/*.hs data/examples/declaration/class/*.hs data/examples/declaration/data/*.hs data/examples/declaration/data/gadt/*.hs data/examples/declaration/default/*.hs data/examples/declaration/deriving/*.hs data/examples/declaration/foreign/*.hs data/examples/declaration/instance/*.hs data/examples/declaration/rewrite-rule/*.hs data/examples/declaration/role-annotation/*.hs data/examples/declaration/signature/complete/*.hs data/examples/declaration/signature/fixity/*.hs data/examples/declaration/signature/inline/*.hs data/examples/declaration/signature/minimal/*.hs data/examples/declaration/signature/pattern/*.hs data/examples/declaration/signature/set-cost-centre/*.hs data/examples/declaration/signature/specialize/*.hs data/examples/declaration/signature/type/*.hs data/examples/declaration/splice/*.hs data/examples/declaration/type-families/closed-type-family/*.hs data/examples/declaration/type-families/data-family/*.hs data/examples/declaration/type-families/type-family/*.hs data/examples/declaration/type-synonyms/*.hs data/examples/declaration/type/*.hs data/examples/declaration/value/function/*.hs data/examples/declaration/value/function/arrow/*.hs data/examples/declaration/value/function/comprehension/*.hs data/examples/declaration/value/function/do/*.hs data/examples/declaration/value/function/infix/*.hs data/examples/declaration/value/function/pattern/*.hs data/examples/declaration/value/other/*.hs data/examples/declaration/value/pattern-synonyms/*.hs data/examples/declaration/warning/*.hs data/examples/import/*.hs data/examples/module-header/*.hs data/examples/other/*.hs extra-doc-files: CONTRIBUTING.md CHANGELOG.md DESIGN.md README.md source-repository head type: git location: https://github.com/tweag/ormolu.git flag dev description: Turn on development settings. default: False manual: True library exposed-modules: Ormolu Ormolu.Config Ormolu.Diff Ormolu.Exception Ormolu.Imports Ormolu.Parser Ormolu.Parser.Anns Ormolu.Parser.CommentStream Ormolu.Parser.Pragma Ormolu.Parser.Result Ormolu.Parser.Shebang Ormolu.Printer Ormolu.Printer.Combinators Ormolu.Printer.Comments Ormolu.Printer.Internal Ormolu.Printer.Meat.Common Ormolu.Printer.Meat.Declaration Ormolu.Printer.Meat.Declaration.Annotation Ormolu.Printer.Meat.Declaration.Class Ormolu.Printer.Meat.Declaration.Data Ormolu.Printer.Meat.Declaration.Default Ormolu.Printer.Meat.Declaration.Foreign Ormolu.Printer.Meat.Declaration.Instance Ormolu.Printer.Meat.Declaration.RoleAnnotation Ormolu.Printer.Meat.Declaration.Rule Ormolu.Printer.Meat.Declaration.Signature Ormolu.Printer.Meat.Declaration.Splice Ormolu.Printer.Meat.Declaration.Type Ormolu.Printer.Meat.Declaration.TypeFamily Ormolu.Printer.Meat.Declaration.Value Ormolu.Printer.Meat.Declaration.Warning Ormolu.Printer.Meat.ImportExport Ormolu.Printer.Meat.Module Ormolu.Printer.Meat.Pragma Ormolu.Printer.Meat.Type Ormolu.Printer.Operators Ormolu.Printer.SpanStream Ormolu.Processing.Common Ormolu.Processing.Cpp Ormolu.Processing.Postprocess Ormolu.Processing.Preprocess Ormolu.Utils hs-source-dirs: src other-modules: GHC GHC.DynFlags default-language: Haskell2010 build-depends: base >=4.12 && <5.0, bytestring >=0.2 && <0.11, containers >=0.5 && <0.7, dlist >=0.8 && <0.9, exceptions >=0.6 && <0.11, ghc-lib-parser >=8.10 && <8.11, mtl >=2.0 && <3.0, syb >=0.7 && <0.8, text >=0.2 && <1.3 if flag(dev) ghc-options: -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -Wno-missing-home-modules else ghc-options: -O2 -Wall executable ormolu main-is: Main.hs hs-source-dirs: app other-modules: Paths_ormolu default-language: Haskell2010 build-depends: base >=4.12 && <5.0, ghc-lib-parser >=8.10 && <8.11, gitrev >=1.3 && <1.4, optparse-applicative >=0.14 && <0.16, ormolu -any, text >=0.2 && <1.3 if flag(dev) ghc-options: -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -optP-Wno-nonportable-include-path else ghc-options: -O2 -Wall -rtsopts test-suite tests type: exitcode-stdio-1.0 main-is: Spec.hs build-tools: hspec-discover >=2.0 && <3.0 hs-source-dirs: tests other-modules: Ormolu.Parser.PragmaSpec Ormolu.PrinterSpec default-language: Haskell2010 build-depends: base >=4.12 && <5.0, containers >=0.5 && <0.7, filepath >=1.2 && <1.5, hspec >=2.0 && <3.0, ormolu -any, path >=0.6 && <0.8, path-io >=1.4.2 && <2.0, text >=0.2 && <1.3 if flag(dev) ghc-options: -Wall -Werror else ghc-options: -O2 -Wall ormolu-0.1.2.0/src/0000755000000000000000000000000007346545000012145 5ustar0000000000000000ormolu-0.1.2.0/src/GHC.hs0000644000000000000000000000030207346545000013075 0ustar0000000000000000module GHC ( module X, ) where import ApiAnnotation as X import BasicTypes as X import GHC.Hs as X import GHC.Hs.Instances as X () import Module as X import RdrName as X import SrcLoc as X ormolu-0.1.2.0/src/GHC/0000755000000000000000000000000007346545000012546 5ustar0000000000000000ormolu-0.1.2.0/src/GHC/DynFlags.hs0000644000000000000000000000230707346545000014613 0ustar0000000000000000{-# OPTIONS_GHC -Wno-missing-fields #-} -- Modified from ghc-lib-api-ext. module GHC.DynFlags ( baseDynFlags, ) where import Config import DynFlags import Fingerprint import GHC.Platform import ToolSettings fakeSettings :: Settings fakeSettings = Settings { sGhcNameVersion = GhcNameVersion { ghcNameVersion_programName = "ghc", ghcNameVersion_projectVersion = cProjectVersion }, sFileSettings = FileSettings {}, sTargetPlatform = Platform { platformWordSize = PW8, platformMini = PlatformMini { platformMini_arch = ArchUnknown, platformMini_os = OSUnknown }, platformUnregisterised = True }, sPlatformMisc = PlatformMisc {}, sPlatformConstants = PlatformConstants {pc_DYNAMIC_BY_DEFAULT = False, pc_WORD_SIZE = 8}, sToolSettings = ToolSettings { toolSettings_opt_P_fingerprint = fingerprint0, toolSettings_pgm_F = "" } } fakeLlvmConfig :: LlvmConfig fakeLlvmConfig = LlvmConfig [] [] baseDynFlags :: DynFlags baseDynFlags = defaultDynFlags fakeSettings fakeLlvmConfig ormolu-0.1.2.0/src/Ormolu.hs0000644000000000000000000001050607346545000013760 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} -- | A formatter for Haskell source code. module Ormolu ( ormolu, ormoluFile, ormoluStdin, Config (..), RegionIndices (..), defaultConfig, DynOption (..), OrmoluException (..), withPrettyOrmoluExceptions, ) where import qualified CmdLineParser as GHC import Control.Exception import Control.Monad import Control.Monad.IO.Class (MonadIO (..)) import Data.Text (Text) import qualified Data.Text as T import Debug.Trace import Ormolu.Config import Ormolu.Diff import Ormolu.Exception import Ormolu.Parser import Ormolu.Parser.Result import Ormolu.Printer import Ormolu.Utils (showOutputable) import qualified SrcLoc as GHC -- | Format a 'String', return formatted version as 'Text'. -- -- The function -- -- * Takes 'String' because that's what GHC parser accepts. -- * Needs 'IO' because some functions from GHC that are necessary to -- setup parsing context require 'IO'. There should be no visible -- side-effects though. -- * Takes file name just to use it in parse error messages. -- * Throws 'OrmoluException'. ormolu :: MonadIO m => -- | Ormolu configuration Config RegionIndices -> -- | Location of source file FilePath -> -- | Input to format String -> m Text ormolu cfgWithIndices path str = do let totalLines = length (lines str) cfg = regionIndicesToDeltas totalLines <$> cfgWithIndices (warnings, result0) <- parseModule' cfg OrmoluParsingFailed path str when (cfgDebug cfg) $ do traceM "warnings:\n" traceM (concatMap showWarn warnings) traceM (prettyPrintParseResult result0) -- We're forcing 'txt' here because otherwise errors (such as messages -- about not-yet-supported functionality) will be thrown later when we try -- to parse the rendered code back, inside of GHC monad wrapper which will -- lead to error messages presenting the exceptions as GHC bugs. let !txt = printModule result0 when (not (cfgUnsafe cfg) || cfgCheckIdempotence cfg) $ do let pathRendered = path ++ "" -- Parse the result of pretty-printing again and make sure that AST -- is the same as AST of original snippet module span positions. (_, result1) <- parseModule' cfg OrmoluOutputParsingFailed pathRendered (T.unpack txt) unless (cfgUnsafe cfg) $ case diffParseResult result0 result1 of Same -> return () Different ss -> liftIO $ throwIO (OrmoluASTDiffers path ss) -- Try re-formatting the formatted result to check if we get exactly -- the same output. when (cfgCheckIdempotence cfg) $ let txt2 = printModule result1 in case diffText txt txt2 pathRendered of Nothing -> return () Just (loc, l, r) -> liftIO $ throwIO (OrmoluNonIdempotentOutput loc l r) return txt -- | Load a file and format it. The file stays intact and the rendered -- version is returned as 'Text'. -- -- > ormoluFile cfg path = -- > liftIO (readFile path) >>= ormolu cfg path ormoluFile :: MonadIO m => -- | Ormolu configuration Config RegionIndices -> -- | Location of source file FilePath -> -- | Resulting rendition m Text ormoluFile cfg path = liftIO (readFile path) >>= ormolu cfg path -- | Read input from stdin and format it. -- -- > ormoluStdin cfg = -- > liftIO (hGetContents stdin) >>= ormolu cfg "" ormoluStdin :: MonadIO m => -- | Ormolu configuration Config RegionIndices -> -- | Resulting rendition m Text ormoluStdin cfg = liftIO getContents >>= ormolu cfg "" ---------------------------------------------------------------------------- -- Helpers -- | A wrapper around 'parseModule'. parseModule' :: MonadIO m => -- | Ormolu configuration Config RegionDeltas -> -- | How to obtain 'OrmoluException' to throw when parsing fails (GHC.SrcSpan -> String -> OrmoluException) -> -- | File name to use in errors FilePath -> -- | Actual input for the parser String -> m ([GHC.Warn], ParseResult) parseModule' cfg mkException path str = do (warnings, r) <- parseModule cfg path str case r of Left (spn, err) -> liftIO $ throwIO (mkException spn err) Right x -> return (warnings, x) -- | Pretty-print a 'GHC.Warn'. showWarn :: GHC.Warn -> String showWarn (GHC.Warn reason l) = unlines [ showOutputable reason, showOutputable l ] ormolu-0.1.2.0/src/Ormolu/0000755000000000000000000000000007346545000013422 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Config.hs0000644000000000000000000000461007346545000015164 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RecordWildCards #-} -- | Configuration options used by the tool. module Ormolu.Config ( Config (..), RegionIndices (..), RegionDeltas (..), defaultConfig, regionIndicesToDeltas, DynOption (..), dynOptionToLocatedStr, ) where import qualified SrcLoc as GHC -- | Ormolu configuration. data Config region = Config { -- | Dynamic options to pass to GHC parser cfgDynOptions :: ![DynOption], -- | Do formatting faster but without automatic detection of defects cfgUnsafe :: !Bool, -- | Output information useful for debugging cfgDebug :: !Bool, -- | Checks if re-formatting the result is idempotent cfgCheckIdempotence :: !Bool, -- | Region selection cfgRegion :: !region } deriving (Eq, Show, Functor) -- | Region selection as the combination of start and end line numbers. data RegionIndices = RegionIndices { -- | Start line of the region to format regionStartLine :: !(Maybe Int), -- | End line of the region to format regionEndLine :: !(Maybe Int) } deriving (Eq, Show) -- | Region selection as the length of the literal prefix and the literal -- suffix. data RegionDeltas = RegionDeltas { -- | Prefix length in number of lines regionPrefixLength :: !Int, -- | Suffix length in number of lines regionSuffixLength :: !Int } deriving (Eq, Show) -- | Default @'Config' 'RegionIndices'@. defaultConfig :: Config RegionIndices defaultConfig = Config { cfgDynOptions = [], cfgUnsafe = False, cfgDebug = False, cfgCheckIdempotence = False, cfgRegion = RegionIndices { regionStartLine = Nothing, regionEndLine = Nothing } } -- | Convert 'RegionIndices' into 'RegionDeltas'. regionIndicesToDeltas :: -- | Total number of lines in the input Int -> -- | Region indices RegionIndices -> -- | Region deltas RegionDeltas regionIndicesToDeltas total RegionIndices {..} = RegionDeltas { regionPrefixLength = maybe 0 (subtract 1) regionStartLine, regionSuffixLength = maybe 0 (total -) regionEndLine } -- | A wrapper for dynamic options. newtype DynOption = DynOption { unDynOption :: String } deriving (Eq, Ord, Show) -- | Convert 'DynOption' to @'GHC.Located' 'String'@. dynOptionToLocatedStr :: DynOption -> GHC.Located String dynOptionToLocatedStr (DynOption o) = GHC.L GHC.noSrcSpan o ormolu-0.1.2.0/src/Ormolu/Diff.hs0000644000000000000000000001135607346545000014634 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} -- | Diffing GHC ASTs modulo span positions. module Ormolu.Diff ( Diff (..), diffParseResult, diffText, ) where import Data.ByteString (ByteString) import Data.Generics import Data.Text (Text) import qualified Data.Text as T import qualified FastString as GHC import GHC import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Utils -- | Result of comparing two 'ParseResult's. data Diff = -- | Two parse results are the same Same | -- | Two parse results differ Different [SrcSpan] instance Semigroup Diff where Same <> a = a a <> Same = a Different xs <> Different ys = Different (xs ++ ys) instance Monoid Diff where mempty = Same -- | Return 'Diff' of two 'ParseResult's. diffParseResult :: ParseResult -> ParseResult -> Diff diffParseResult ParseResult { prCommentStream = cstream0, prParsedSource = hs0 } ParseResult { prCommentStream = cstream1, prParsedSource = hs1 } = matchIgnoringSrcSpans cstream0 cstream1 <> matchIgnoringSrcSpans hs0 {hsmodImports = normalizeImports (hsmodImports hs0)} hs1 {hsmodImports = normalizeImports (hsmodImports hs1)} -- | Compare two values for equality disregarding differences in 'SrcSpan's -- and the ordering of import lists. matchIgnoringSrcSpans :: Data a => a -> a -> Diff matchIgnoringSrcSpans = genericQuery where genericQuery :: GenericQ (GenericQ Diff) genericQuery x y -- 'ByteString' implements 'Data' instance manually and does not -- implement 'toConstr', so we have to deal with it in a special way. | Just x' <- cast x, Just y' <- cast y = if x' == (y' :: ByteString) then Same else Different [] | typeOf x == typeOf y, toConstr x == toConstr y = mconcat $ gzipWithQ ( genericQuery `extQ` srcSpanEq `extQ` commentEq `extQ` sourceTextEq `extQ` hsDocStringEq `extQ` importDeclQualifiedStyleEq `ext2Q` forLocated ) x y | otherwise = Different [] srcSpanEq :: SrcSpan -> GenericQ Diff srcSpanEq _ _ = Same commentEq :: Comment -> GenericQ Diff commentEq (Comment _ x) d = case cast d :: Maybe Comment of Nothing -> Different [] Just (Comment _ y) -> if x == y then Same else Different [] sourceTextEq :: SourceText -> GenericQ Diff sourceTextEq _ _ = Same importDeclQualifiedStyleEq :: ImportDeclQualifiedStyle -> GenericQ Diff importDeclQualifiedStyleEq d0 d1' = case (d0, cast d1' :: Maybe ImportDeclQualifiedStyle) of (x, Just x') | x == x' -> Same (QualifiedPre, Just QualifiedPost) -> Same (QualifiedPost, Just QualifiedPre) -> Same _ -> Different [] hsDocStringEq :: HsDocString -> GenericQ Diff hsDocStringEq str0 str1' = case cast str1' :: Maybe HsDocString of Nothing -> Different [] Just str1 -> if splitDocString str0 == splitDocString str1 then Same else Different [] forLocated :: (Data e0, Data e1) => GenLocated e0 e1 -> GenericQ Diff forLocated x@(L mspn _) y = maybe id appendSpan (cast mspn) (genericQuery x y) appendSpan :: SrcSpan -> Diff -> Diff appendSpan s (Different ss) | fresh && helpful = Different (s : ss) where fresh = not $ any (`isSubspanOf` s) ss helpful = isGoodSrcSpan s appendSpan _ d = d -- | Diff two texts and return the location they start to differ, alongside -- with excerpts around that location. diffText :: -- | Text before Text -> -- | Text after Text -> -- | Path to use to construct 'GHC.RealSrcLoc' FilePath -> Maybe (GHC.RealSrcLoc, Text, Text) diffText left right fp = case go (0, 0, 0) left right of Nothing -> Nothing Just (row, col, loc) -> Just ( GHC.mkRealSrcLoc (GHC.mkFastString fp) row col, getSpan loc left, getSpan loc right ) where go (row, col, loc) t1 t2 = case (T.uncons t1, T.uncons t2) of -- both text empty, all good (Nothing, Nothing) -> Nothing -- first chars are the same, adjust position and recurse (Just (c1, r1), Just (c2, r2)) | c1 == c2 -> let (row', col', loc') = if c1 == '\n' then (row + 1, 0, loc + 1) else (row, col + 1, loc + 1) in go (row', col', loc') r1 r2 -- something is different, return the position _ -> Just (row, col, loc) getSpan loc = T.take 20 . T.drop (loc - 10) ormolu-0.1.2.0/src/Ormolu/Exception.hs0000644000000000000000000000625107346545000015720 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} -- | 'OrmoluException' type and surrounding definitions. module Ormolu.Exception ( OrmoluException (..), withPrettyOrmoluExceptions, ) where import Control.Exception import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Text (Text) import qualified GHC import Ormolu.Utils (showOutputable) import qualified Outputable as GHC import System.Exit (ExitCode (..), exitWith) import System.IO -- | Ormolu exception representing all cases when Ormolu can fail. data OrmoluException = -- | Parsing of original source code failed OrmoluParsingFailed GHC.SrcSpan String | -- | Parsing of formatted source code failed OrmoluOutputParsingFailed GHC.SrcSpan String | -- | Original and resulting ASTs differ OrmoluASTDiffers FilePath [GHC.SrcSpan] | -- | Formatted source code is not idempotent OrmoluNonIdempotentOutput GHC.RealSrcLoc Text Text | -- | Some GHC options were not recognized OrmoluUnrecognizedOpts (NonEmpty String) deriving (Eq, Show) instance Exception OrmoluException where displayException = \case OrmoluParsingFailed s e -> showParsingErr "The GHC parser (in Haddock mode) failed:" s [e] OrmoluOutputParsingFailed s e -> showParsingErr "Parsing of formatted code failed:" s [e] ++ "Please, consider reporting the bug.\n" OrmoluASTDiffers path ss -> unlines $ [ "AST of input and AST of formatted code differ." ] ++ fmap withIndent ( case fmap (\s -> "at " ++ showOutputable s) ss of [] -> ["in " ++ path] xs -> xs ) ++ ["Please, consider reporting the bug."] OrmoluNonIdempotentOutput loc left right -> showParsingErr "Formatting is not idempotent:" loc ["before: " ++ show left, "after: " ++ show right] ++ "Please, consider reporting the bug.\n" OrmoluUnrecognizedOpts opts -> unlines [ "The following GHC options were not recognized:", (withIndent . unwords . NE.toList) opts ] -- | Inside this wrapper 'OrmoluException' will be caught and displayed -- nicely using 'displayException'. withPrettyOrmoluExceptions :: -- | Action that may throw the exception IO a -> IO a withPrettyOrmoluExceptions m = m `catch` h where h :: OrmoluException -> IO a h e = do hPutStrLn stderr (displayException e) exitWith . ExitFailure $ case e of -- Error code 1 is for 'error' or 'notImplemented' -- 2 used to be for erroring out on CPP OrmoluParsingFailed {} -> 3 OrmoluOutputParsingFailed {} -> 4 OrmoluASTDiffers {} -> 5 OrmoluNonIdempotentOutput {} -> 6 OrmoluUnrecognizedOpts {} -> 7 ---------------------------------------------------------------------------- -- Helpers -- | Show a parse error. showParsingErr :: GHC.Outputable a => String -> a -> [String] -> String showParsingErr msg spn err = unlines $ [ msg, withIndent (showOutputable spn) ] ++ map withIndent err -- | Indent with 2 spaces for readability. withIndent :: String -> String withIndent txt = " " ++ txt ormolu-0.1.2.0/src/Ormolu/Imports.hs0000644000000000000000000001664107346545000015423 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} -- | Manipulations on import lists. module Ormolu.Imports ( normalizeImports, ) where import Data.Bifunctor import Data.Char (isAlphaNum) import Data.Function (on) import Data.List (foldl', nubBy, sortBy, sortOn) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import FastString (FastString) import GHC hiding (GhcPs, IE) import GHC.Hs.Extension import GHC.Hs.ImpExp (IE (..)) import Ormolu.Utils (notImplemented, showOutputable) -- | Sort and normalize imports. normalizeImports :: [LImportDecl GhcPs] -> [LImportDecl GhcPs] normalizeImports = fmap snd . M.toAscList . M.fromListWith combineImports . fmap (\x -> (importId x, g x)) where g (L l ImportDecl {..}) = L l ImportDecl { ideclHiding = second (fmap normalizeLies) <$> ideclHiding, .. } g _ = notImplemented "XImportDecl" -- | Combine two import declarations. It should be assumed that 'ImportId's -- are equal. combineImports :: LImportDecl GhcPs -> LImportDecl GhcPs -> LImportDecl GhcPs combineImports (L lx ImportDecl {..}) (L _ y) = L lx ImportDecl { ideclHiding = case (ideclHiding, GHC.ideclHiding y) of (Just (hiding, L l' xs), Just (_, L _ ys)) -> Just (hiding, (L l' (normalizeLies (xs ++ ys)))) _ -> Nothing, .. } combineImports _ _ = notImplemented "XImportDecl" -- | Import id, a collection of all things that justify having a separate -- import entry. This is used for merging of imports. If two imports have -- the same 'ImportId' they can be merged. data ImportId = ImportId { importIsPrelude :: Bool, importIdName :: ModuleName, importPkgQual :: Maybe FastString, importSource :: Bool, importSafe :: Bool, importQualified :: Bool, importImplicit :: Bool, importAs :: Maybe ModuleName, importHiding :: Maybe Bool } deriving (Eq, Ord) -- | Obtain an 'ImportId' for a given import. importId :: LImportDecl GhcPs -> ImportId importId (L _ ImportDecl {..}) = ImportId { importIsPrelude = isPrelude, importIdName = moduleName, importPkgQual = sl_fs <$> ideclPkgQual, importSource = ideclSource, importSafe = ideclSafe, importQualified = case ideclQualified of QualifiedPre -> True QualifiedPost -> True NotQualified -> False, importImplicit = ideclImplicit, importAs = unLoc <$> ideclAs, importHiding = fst <$> ideclHiding } where isPrelude = moduleNameString moduleName == "Prelude" moduleName = unLoc ideclName importId _ = notImplemented "XImportDecl" -- | Normalize a collection of import\/export items. normalizeLies :: [LIE GhcPs] -> [LIE GhcPs] normalizeLies = sortOn (getIewn . unLoc) . M.elems . foldl' combine M.empty where combine :: Map IEWrappedNameOrd (LIE GhcPs) -> LIE GhcPs -> Map IEWrappedNameOrd (LIE GhcPs) combine m (L new_l new) = let wname = getIewn new normalizeWNames = nubBy (\x y -> compareLIewn x y == EQ) . sortBy compareLIewn alter = \case Nothing -> Just . L new_l $ case new of IEThingWith NoExtField n wildcard g flbl -> IEThingWith NoExtField n wildcard (normalizeWNames g) flbl other -> other Just old -> let f = \case IEVar NoExtField n -> IEVar NoExtField n IEThingAbs NoExtField _ -> new IEThingAll NoExtField n -> IEThingAll NoExtField n IEThingWith NoExtField n wildcard g flbl -> case new of IEVar NoExtField _ -> error "Ormolu.Imports broken presupposition" IEThingAbs NoExtField _ -> IEThingWith NoExtField n wildcard g flbl IEThingAll NoExtField n' -> IEThingAll NoExtField n' IEThingWith NoExtField n' wildcard' g' flbl' -> let combinedWildcard = case (wildcard, wildcard') of (IEWildcard _, _) -> IEWildcard 0 (_, IEWildcard _) -> IEWildcard 0 _ -> NoIEWildcard in IEThingWith NoExtField n' combinedWildcard (normalizeWNames (g <> g')) flbl' IEModuleContents NoExtField _ -> notImplemented "IEModuleContents" IEGroup NoExtField _ _ -> notImplemented "IEGroup" IEDoc NoExtField _ -> notImplemented "IEDoc" IEDocNamed NoExtField _ -> notImplemented "IEDocNamed" XIE x -> noExtCon x IEModuleContents NoExtField _ -> notImplemented "IEModuleContents" IEGroup NoExtField _ _ -> notImplemented "IEGroup" IEDoc NoExtField _ -> notImplemented "IEDoc" IEDocNamed NoExtField _ -> notImplemented "IEDocNamed" XIE x -> noExtCon x in Just (f <$> old) in M.alter alter wname m -- | A wrapper for @'IEWrappedName' 'RdrName'@ that allows us to define an -- 'Ord' instance for it. newtype IEWrappedNameOrd = IEWrappedNameOrd (IEWrappedName RdrName) deriving (Eq) instance Ord IEWrappedNameOrd where compare (IEWrappedNameOrd x) (IEWrappedNameOrd y) = compareIewn x y -- | Project @'IEWrappedName' 'RdrName'@ from @'IE' 'GhcPs'@. getIewn :: IE GhcPs -> IEWrappedNameOrd getIewn = \case IEVar NoExtField x -> IEWrappedNameOrd (unLoc x) IEThingAbs NoExtField x -> IEWrappedNameOrd (unLoc x) IEThingAll NoExtField x -> IEWrappedNameOrd (unLoc x) IEThingWith NoExtField x _ _ _ -> IEWrappedNameOrd (unLoc x) IEModuleContents NoExtField _ -> notImplemented "IEModuleContents" IEGroup NoExtField _ _ -> notImplemented "IEGroup" IEDoc NoExtField _ -> notImplemented "IEDoc" IEDocNamed NoExtField _ -> notImplemented "IEDocNamed" XIE x -> noExtCon x -- | Like 'compareIewn' for located wrapped names. compareLIewn :: LIEWrappedName RdrName -> LIEWrappedName RdrName -> Ordering compareLIewn = compareIewn `on` unLoc -- | Compare two @'IEWrapppedName' 'RdrName'@ things. compareIewn :: IEWrappedName RdrName -> IEWrappedName RdrName -> Ordering compareIewn (IEName x) (IEName y) = unLoc x `compareRdrName` unLoc y compareIewn (IEName _) (IEPattern _) = LT compareIewn (IEName _) (IEType _) = LT compareIewn (IEPattern _) (IEName _) = GT compareIewn (IEPattern x) (IEPattern y) = unLoc x `compareRdrName` unLoc y compareIewn (IEPattern _) (IEType _) = LT compareIewn (IEType _) (IEName _) = GT compareIewn (IEType _) (IEPattern _) = GT compareIewn (IEType x) (IEType y) = unLoc x `compareRdrName` unLoc y compareRdrName :: RdrName -> RdrName -> Ordering compareRdrName x y = case (getNameStr x, getNameStr y) of ([], []) -> EQ ((_ : _), []) -> GT ([], (_ : _)) -> LT ((x' : _), (y' : _)) -> case (isAlphaNum x', isAlphaNum y') of (False, False) -> x `compare` y (True, False) -> LT (False, True) -> GT (True, True) -> x `compare` y where getNameStr = showOutputable . rdrNameOcc ormolu-0.1.2.0/src/Ormolu/Parser.hs0000644000000000000000000001707007346545000015217 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- | Parser for Haskell source code. module Ormolu.Parser ( parseModule, manualExts, ) where import Bag (bagToList) import qualified CmdLineParser as GHC import Control.Exception import Control.Monad.IO.Class import qualified Data.List as L import qualified Data.List.NonEmpty as NE import Data.Ord (Down (Down)) import qualified Data.Text as T import DynFlags as GHC import ErrUtils (Severity (..), errMsgSeverity, errMsgSpan) import qualified FastString as GHC import GHC hiding (IE, UnicodeSyntax) import GHC.DynFlags (baseDynFlags) import GHC.LanguageExtensions.Type (Extension (..)) import qualified HeaderInfo as GHC import qualified HscTypes as GHC import qualified Lexer as GHC import Ormolu.Config import Ormolu.Exception import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Result import Ormolu.Processing.Preprocess (preprocess) import Ormolu.Utils (incSpanLine, removeIndentation) import qualified Panic as GHC import qualified Parser as GHC import qualified StringBuffer as GHC -- | Parse a complete module from string. parseModule :: MonadIO m => -- | Ormolu configuration Config RegionDeltas -> -- | File name (only for source location annotations) FilePath -> -- | Input for parser String -> m ( [GHC.Warn], Either (SrcSpan, String) ParseResult ) parseModule Config {..} path rawInput = liftIO $ do let (literalPrefix, indentedInput, literalSuffix, extraComments) = preprocess path rawInput cfgRegion (input, indent) = removeIndentation indentedInput -- It's important that 'setDefaultExts' is done before -- 'parsePragmasIntoDynFlags', because otherwise we might enable an -- extension that was explicitly disabled in the file. let baseFlags = GHC.setGeneralFlag' GHC.Opt_Haddock (setDefaultExts baseDynFlags) extraOpts = dynOptionToLocatedStr <$> cfgDynOptions (warnings, dynFlags) <- parsePragmasIntoDynFlags baseFlags extraOpts path rawInput >>= \case Right res -> pure res Left err -> let loc = mkSrcSpan (mkSrcLoc (GHC.mkFastString path) 1 1) (mkSrcLoc (GHC.mkFastString path) 1 1) in throwIO (OrmoluParsingFailed loc err) let useRecordDot = "record-dot-preprocessor" == pgm_F dynFlags || any (("RecordDotPreprocessor" ==) . moduleNameString) (pluginModNames dynFlags) pStateErrors = \pstate -> let errs = bagToList $ GHC.getErrorMessages pstate dynFlags fixupErrSpan = incSpanLine (regionPrefixLength cfgRegion) in case L.sortOn (Down . SeverityOrd . errMsgSeverity) errs of [] -> Nothing err : _ -> -- Show instance returns a short error message Just (fixupErrSpan (errMsgSpan err), show err) r = case runParser GHC.parseModule dynFlags path input of GHC.PFailed pstate -> case pStateErrors pstate of Just err -> Left err Nothing -> error "PFailed does not have an error" GHC.POk pstate (L _ hsModule) -> case pStateErrors pstate of -- Some parse errors (pattern/arrow syntax in expr context) -- do not cause a parse error, but they are replaced with "_" -- by the parser and the modified AST is propagated to the -- later stages; but we fail in those cases. Just err -> Left err Nothing -> let (stackHeader, shebangs, pragmas, comments) = mkCommentStream input extraComments pstate in Right ParseResult { prParsedSource = hsModule, prAnns = mkAnns pstate, prStackHeader = stackHeader, prShebangs = shebangs, prPragmas = pragmas, prCommentStream = comments, prUseRecordDot = useRecordDot, prImportQualifiedPost = GHC.xopt ImportQualifiedPost dynFlags, prLiteralPrefix = T.pack literalPrefix, prLiteralSuffix = T.pack literalSuffix, prIndent = indent } return (warnings, r) -- | Enable all language extensions that we think should be enabled by -- default for ease of use. setDefaultExts :: DynFlags -> DynFlags setDefaultExts flags = L.foldl' xopt_set flags autoExts where autoExts = allExts L.\\ manualExts allExts = [minBound .. maxBound] -- | Extensions that are not enabled automatically and should be activated -- by user. manualExts :: [Extension] manualExts = [ Arrows, -- steals proc Cpp, -- forbidden BangPatterns, -- makes certain patterns with ! fail PatternSynonyms, -- steals the pattern keyword RecursiveDo, -- steals the rec keyword StaticPointers, -- steals static keyword TransformListComp, -- steals the group keyword UnboxedTuples, -- breaks (#) lens operator MagicHash, -- screws {-# these things #-} TypeApplications, -- steals (@) operator on some cases AlternativeLayoutRule, AlternativeLayoutRuleTransitional, MonadComprehensions, UnboxedSums, UnicodeSyntax, -- gives special meanings to operators like (→) TemplateHaskellQuotes, -- enables TH subset of quasi-quotes, this -- apparently interferes with QuasiQuotes in -- weird ways ImportQualifiedPost -- affects how Ormolu renders imports, so the -- decision of enabling this style is left to the user ] -- | Run a 'GHC.P' computation. runParser :: -- | Computation to run GHC.P a -> -- | Dynamic flags GHC.DynFlags -> -- | Module path FilePath -> -- | Module contents String -> -- | Parse result GHC.ParseResult a runParser parser flags filename input = GHC.unP parser parseState where location = GHC.mkRealSrcLoc (GHC.mkFastString filename) 1 1 buffer = GHC.stringToStringBuffer input parseState = GHC.mkPState flags buffer location -- | Wrap GHC's 'Severity' to add 'Ord' instance. newtype SeverityOrd = SeverityOrd Severity instance Eq SeverityOrd where s1 == s2 = compare s1 s2 == EQ instance Ord SeverityOrd where compare (SeverityOrd s1) (SeverityOrd s2) = compare (f s1) (f s2) where f :: Severity -> Int f SevOutput = 1 f SevFatal = 2 f SevInteractive = 3 f SevDump = 4 f SevInfo = 5 f SevWarning = 6 f SevError = 7 ---------------------------------------------------------------------------- -- Helpers taken from HLint parsePragmasIntoDynFlags :: -- | Pre-set 'DynFlags' DynFlags -> -- | Extra options (provided by user) [Located String] -> -- | File name (only for source location annotations) FilePath -> -- | Input for parser String -> IO (Either String ([GHC.Warn], DynFlags)) parsePragmasIntoDynFlags flags extraOpts filepath str = catchErrors $ do let opts = GHC.getOptions flags (GHC.stringToStringBuffer str) filepath (flags', leftovers, warnings) <- parseDynamicFilePragma flags (opts <> extraOpts) case NE.nonEmpty leftovers of Nothing -> return () Just unrecognizedOpts -> throwIO (OrmoluUnrecognizedOpts (unLoc <$> unrecognizedOpts)) let flags'' = flags' `gopt_set` Opt_KeepRawTokenStream return $ Right (warnings, flags'') where catchErrors act = GHC.handleGhcException reportErr (GHC.handleSourceError reportErr act) reportErr e = return $ Left (show e) ormolu-0.1.2.0/src/Ormolu/Parser/0000755000000000000000000000000007346545000014656 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Parser/Anns.hs0000644000000000000000000000210007346545000016102 0ustar0000000000000000-- | 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 _) _ = [] ormolu-0.1.2.0/src/Ormolu/Parser/CommentStream.hs0000644000000000000000000001701107346545000017770 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} -- | Functions for working with comment stream. module Ormolu.Parser.CommentStream ( -- * Comment stream CommentStream (..), mkCommentStream, showCommentStream, -- * Comment Comment (..), unComment, hasAtomsBefore, isMultilineComment, ) where import Data.Char (isSpace) import Data.Data (Data) import qualified Data.List as L import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (mapMaybe) import qualified GHC import qualified Lexer as GHC import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang import Ormolu.Processing.Common import Ormolu.Utils (onTheSameLine, showOutputable) import SrcLoc ---------------------------------------------------------------------------- -- Comment stream -- | A stream of 'RealLocated' 'Comment's in ascending order with respect to -- beginning of corresponding spans. newtype CommentStream = CommentStream [RealLocated Comment] deriving (Eq, Data, Semigroup, Monoid) -- | Create 'CommentStream' from 'GHC.PState'. The pragmas and shebangs are -- removed from the 'CommentStream'. Shebangs are only extracted from the -- comments that come from the first argument. mkCommentStream :: -- | Original input String -> -- | Extra comments to include [Located String] -> -- | Parser state to use for comment extraction GHC.PState -> -- | Stack header, shebangs, pragmas, and comment stream ( Maybe (RealLocated Comment), [Shebang], [([RealLocated Comment], Pragma)], CommentStream ) mkCommentStream input extraComments pstate = ( mstackHeader, shebangs, pragmas, CommentStream comments ) where (comments, pragmas) = extractPragmas input rawComments1 (rawComments1, mstackHeader) = extractStackHeader rawComments0 rawComments0 = L.sortOn (realSrcSpanStart . getRealSrcSpan) . mapMaybe toRealSpan $ otherExtraComments ++ mapMaybe (liftMaybe . fmap unAnnotationComment) (GHC.comment_q pstate) ++ concatMap (mapMaybe (liftMaybe . fmap unAnnotationComment) . snd) (GHC.annotations_comments pstate) (shebangs, otherExtraComments) = extractShebangs extraComments -- | Pretty-print a 'CommentStream'. showCommentStream :: CommentStream -> String showCommentStream (CommentStream xs) = unlines $ showComment <$> xs where showComment (GHC.L l str) = showOutputable l ++ " " ++ show str ---------------------------------------------------------------------------- -- Comment -- | A wrapper for a single comment. The 'Bool' indicates whether there were -- atoms before beginning of the comment in the original input. The -- 'NonEmpty' list inside contains lines of multiline comment @{- … -}@ or -- just single item\/line otherwise. data Comment = Comment Bool (NonEmpty String) deriving (Eq, Show, Data) -- | Normalize comment string. Sometimes one multi-line comment is turned -- into several lines for subsequent outputting with correct indentation for -- each line. mkComment :: -- | Lines of original input with their indices [(Int, String)] -> -- | Raw comment string RealLocated String -> -- | Remaining lines of original input and the constructed 'Comment' ([(Int, String)], RealLocated Comment) mkComment ls (L l s) = (ls', comment) where comment = L l . Comment atomsBefore . removeConseqBlanks . fmap dropTrailing $ if "{-" `L.isPrefixOf` s then case NE.nonEmpty (lines s) of Nothing -> s :| [] Just (x :| xs) -> let getIndent y = if all isSpace y || y == endDisabling then startIndent else length (takeWhile isSpace y) n = minimum (startIndent : fmap getIndent xs) removeIndent y = if y == endDisabling then y else drop n y in x :| (removeIndent <$> xs) else s :| [] (atomsBefore, ls') = case dropWhile ((< commentLine) . fst) ls of [] -> (False, []) ((_, i) : ls'') -> case take 2 (dropWhile isSpace i) of "--" -> (False, ls'') "{-" -> (False, ls'') _ -> (True, ls'') dropTrailing = L.dropWhileEnd isSpace startIndent = srcSpanStartCol l - 1 commentLine = srcSpanStartLine l -- | Get a collection of lines from a 'Comment'. unComment :: Comment -> NonEmpty String unComment (Comment _ xs) = xs -- | Check whether the 'Comment' had some non-whitespace atoms in front of -- it in the original input. hasAtomsBefore :: Comment -> Bool hasAtomsBefore (Comment atomsBefore _) = atomsBefore -- | Is this comment multiline-style? isMultilineComment :: Comment -> Bool isMultilineComment (Comment _ (x :| _)) = "{-" `L.isPrefixOf` x ---------------------------------------------------------------------------- -- Helpers -- | Detect and extract stack header if it is present. extractStackHeader :: -- | Comment stream to analyze [RealLocated String] -> ([RealLocated String], Maybe (RealLocated Comment)) extractStackHeader = \case [] -> ([], Nothing) (x : xs) -> let comment = snd (mkComment [] x) in if isStackHeader (unRealSrcSpan comment) then (xs, Just comment) else (x : xs, Nothing) where isStackHeader (Comment _ (x :| _)) = "stack" `L.isPrefixOf` dropWhile isSpace (drop 2 x) -- | Extract pragmas and their associated comments. extractPragmas :: -- | Input String -> -- | Comment stream to analyze [RealLocated String] -> ([RealLocated Comment], [([RealLocated Comment], Pragma)]) extractPragmas input = go initialLs id id where initialLs = zip [1 ..] (lines input) go ls csSoFar pragmasSoFar = \case [] -> (csSoFar [], pragmasSoFar []) (x : xs) -> case parsePragma (unRealSrcSpan x) of Nothing -> let (ls', x') = mkComment ls x in go ls' (csSoFar . (x' :)) pragmasSoFar xs Just pragma -> let combined ys = (csSoFar ys, pragma) go' ls' ys rest = go ls' id (pragmasSoFar . (combined ys :)) rest in case xs of [] -> go' ls [] xs (y : ys) -> let (ls', y') = mkComment ls y in if onTheSameLine (RealSrcSpan (getRealSrcSpan x)) (RealSrcSpan (getRealSrcSpan y)) then go' ls' [y'] ys else go' ls [] xs -- | Get a 'String' from 'GHC.AnnotationComment'. unAnnotationComment :: GHC.AnnotationComment -> Maybe String unAnnotationComment = \case GHC.AnnDocCommentNext _ -> Nothing -- @-- |@ GHC.AnnDocCommentPrev _ -> Nothing -- @-- ^@ GHC.AnnDocCommentNamed _ -> Nothing -- @-- $@ GHC.AnnDocSection _ _ -> Nothing -- @-- *@ GHC.AnnDocOptions s -> Just s GHC.AnnLineComment s -> Just s GHC.AnnBlockComment s -> Just s liftMaybe :: Located (Maybe a) -> Maybe (Located a) liftMaybe = \case L _ Nothing -> Nothing L l (Just a) -> Just (L l a) toRealSpan :: Located a -> Maybe (RealLocated a) toRealSpan (L (RealSrcSpan l) a) = Just (L l a) toRealSpan _ = Nothing -- | Remove consecutive blank lines. removeConseqBlanks :: NonEmpty String -> NonEmpty String removeConseqBlanks (x :| xs) = x :| go (null x) id xs where go seenBlank acc = \case [] -> acc [] (y : ys) -> if seenBlank && null y then go True acc ys else go (null y) (acc . (y :)) ys ormolu-0.1.2.0/src/Ormolu/Parser/Pragma.hs0000644000000000000000000000474307346545000016431 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | A module for parsing of pragmas from comments. module Ormolu.Parser.Pragma ( Pragma (..), parsePragma, ) where import Control.Monad import Data.Char (isSpace, toLower) import qualified Data.List as L import qualified EnumSet as ES import FastString (mkFastString, unpackFS) import qualified Lexer as L import Module (ComponentId (..), newSimpleUnitId) import SrcLoc import StringBuffer -- | Ormolu's representation of pragmas. data Pragma = -- | Language pragma PragmaLanguage [String] | -- | GHC options pragma PragmaOptionsGHC String | -- | Haddock options pragma PragmaOptionsHaddock String deriving (Show, Eq) -- | Extract a pragma from a comment if possible, or return 'Nothing' -- otherwise. parsePragma :: -- | Comment to try to parse String -> Maybe Pragma parsePragma input = do inputNoPrefix <- L.stripPrefix "{-#" input guard ("#-}" `L.isSuffixOf` input) let contents = take (length inputNoPrefix - 3) inputNoPrefix (pragmaName, cs) = (break isSpace . dropWhile isSpace) contents case toLower <$> pragmaName of "language" -> PragmaLanguage <$> parseExtensions cs "options_ghc" -> Just $ PragmaOptionsGHC (trimSpaces cs) "options_haddock" -> Just $ PragmaOptionsHaddock (trimSpaces cs) _ -> Nothing where trimSpaces :: String -> String trimSpaces = L.dropWhileEnd isSpace . dropWhile isSpace -- | Assuming the input consists of a series of tokens from a language -- pragma, return the set of enabled extensions. parseExtensions :: String -> Maybe [String] parseExtensions str = tokenize str >>= go where go = \case [L.ITconid ext] -> return [unpackFS ext] (L.ITconid ext : L.ITcomma : xs) -> (unpackFS ext :) <$> go xs _ -> Nothing -- | Tokenize a given input using GHC's lexer. tokenize :: String -> Maybe [L.Token] tokenize input = case L.unP pLexer parseState of L.PFailed {} -> Nothing L.POk _ x -> Just x where location = mkRealSrcLoc (mkFastString "") 1 1 buffer = stringToStringBuffer input parseState = L.mkPStatePure parserFlags buffer location parserFlags = L.mkParserFlags' ES.empty ES.empty (newSimpleUnitId (ComponentId (mkFastString ""))) True True True True -- | Haskell lexer. pLexer :: L.P [L.Token] pLexer = go where go = do r <- L.lexer False return case unLoc r of L.ITeof -> return [] x -> (x :) <$> go ormolu-0.1.2.0/src/Ormolu/Parser/Result.hs0000644000000000000000000000274507346545000016500 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} -- | A type for result of parsing. module Ormolu.Parser.Result ( ParseResult (..), prettyPrintParseResult, ) where import Data.Text (Text) import GHC import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma) import Ormolu.Parser.Shebang (Shebang) -- | A collection of data that represents a parsed module in Ormolu. data ParseResult = ParseResult { -- | 'ParsedSource' from GHC prParsedSource :: HsModule GhcPs, -- | Ormolu-specfic representation of annotations prAnns :: Anns, -- | Stack header prStackHeader :: Maybe (RealLocated Comment), -- | Shebangs found in the input prShebangs :: [Shebang], -- | Pragmas and the associated comments prPragmas :: [([RealLocated Comment], Pragma)], -- | Comment stream prCommentStream :: CommentStream, -- | Whether or not record dot syntax is enabled prUseRecordDot :: Bool, -- | Whether or not ImportQualifiedPost is enabled prImportQualifiedPost :: Bool, -- | Literal prefix prLiteralPrefix :: Text, -- | Literal suffix prLiteralSuffix :: Text, -- | Indentation level, can be non-zero in case of region formatting prIndent :: Int } -- | Pretty-print a 'ParseResult'. prettyPrintParseResult :: ParseResult -> String prettyPrintParseResult ParseResult {..} = unlines [ "parse result:", " comment stream:", showCommentStream prCommentStream -- XXX extend as needed ] ormolu-0.1.2.0/src/Ormolu/Parser/Shebang.hs0000644000000000000000000000130707346545000016562 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} -- | A module for dealing with shebangs. module Ormolu.Parser.Shebang ( Shebang (..), extractShebangs, isShebang, ) where import Data.Data (Data) import qualified Data.List as L import SrcLoc -- | A wrapper for a shebang. newtype Shebang = Shebang (Located String) deriving (Eq, Data) -- | Extract shebangs from the beginning of a comment stream. extractShebangs :: [Located String] -> ([Shebang], [Located String]) extractShebangs comments = (Shebang <$> shebangs, rest) where (shebangs, rest) = span (isShebang . unLoc) comments -- | Return 'True' if given 'String' is a shebang. isShebang :: String -> Bool isShebang str = "#!" `L.isPrefixOf` str ormolu-0.1.2.0/src/Ormolu/Printer.hs0000644000000000000000000000154107346545000015402 0ustar0000000000000000{-# LANGUAGE RecordWildCards #-} -- | Pretty-printer for Haskell AST. module Ormolu.Printer ( printModule, ) where import Data.Text (Text) import Ormolu.Parser.Result import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Module import Ormolu.Printer.SpanStream import Ormolu.Processing.Postprocess (postprocess) -- | Render a module. printModule :: -- | Result of parsing ParseResult -> -- | Resulting rendition Text printModule ParseResult {..} = prLiteralPrefix <> region <> prLiteralSuffix where region = postprocess prIndent $ runR ( p_hsModule prStackHeader prShebangs prPragmas prImportQualifiedPost prParsedSource ) (mkSpanStream prParsedSource) prCommentStream prAnns prUseRecordDot ormolu-0.1.2.0/src/Ormolu/Printer/0000755000000000000000000000000007346545000015045 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Printer/Combinators.hs0000644000000000000000000001601307346545000017662 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | Printing combinators. The definitions here are presented in such an -- order so you can just go through the Haddocks and by the end of the file -- you should have a pretty good idea how to program rendering logic. module Ormolu.Printer.Combinators ( -- * The 'R' monad R, runR, getAnns, getEnclosingSpan, -- * Combinators -- ** Basic txt, atom, space, newline, inci, inciIf, 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, commaDel, equals, -- ** Stateful markers SpanMark (..), spanMarkSpan, HaddockStyle (..), setSpanMark, getSpanMark, ) where import Control.Monad import Data.List (intersperse) import Data.Text (Text) import Ormolu.Printer.Comments import Ormolu.Printer.Internal import SrcLoc ---------------------------------------------------------------------------- -- Basic -- | Indent the inner expression if the first argument is 'True'. inciIf :: -- | Whether to indent Bool -> -- | The expression to indent R () -> R () inciIf b m = if b then inci m else m -- | Enter a 'Located' entity. This combinator handles outputting comments -- and sets layout (single-line vs multi-line) for the inner computation. -- Roughly, the rule for using 'located' is that every time there is a -- 'Located' wrapper, it should be “discharged” with a corresponding -- 'located' invocation. located :: -- | Thing to enter Located a -> -- | How to render inner value (a -> R ()) -> R () located (L (UnhelpfulSpan _) a) f = f a located (L (RealSrcSpan l) a) f = do spitPrecedingComments l withEnclosingSpan l $ switchLayout [RealSrcSpan l] (f a) spitFollowingComments l -- | A version of 'located' with arguments flipped. located' :: -- | How to render inner value (a -> R ()) -> -- | Thing to enter Located a -> R () located' = flip located -- | Set layout according to combination of given 'SrcSpan's for a given. -- Use this only when you need to set layout based on e.g. combined span of -- several elements when there is no corresponding 'Located' wrapper -- provided by GHC AST. It is relatively rare that this one is needed. -- -- Given empty list this function will set layout to single line. switchLayout :: -- | Span that controls layout [SrcSpan] -> -- | Computation to run with changed layout R () -> R () switchLayout spans' = enterLayout (spansLayout spans') -- | Which layout combined spans result in? spansLayout :: [SrcSpan] -> Layout spansLayout = \case [] -> SingleLine (x : xs) -> if isOneLineSpan (foldr combineSrcSpans x xs) then SingleLine else MultiLine -- | Insert a space if enclosing layout is single-line, or newline if it's -- multiline. -- -- > breakpoint = vlayout space newline breakpoint :: R () breakpoint = vlayout space newline -- | Similar to 'breakpoint' but outputs nothing in case of single-line -- layout. -- -- > breakpoint' = vlayout (return ()) newline breakpoint' :: R () breakpoint' = vlayout (return ()) newline ---------------------------------------------------------------------------- -- Formatting lists -- | Render a collection of elements inserting a separator between them. sep :: -- | Separator R () -> -- | How to render an element (a -> R ()) -> -- | Elements to render [a] -> R () sep s f xs = sequence_ (intersperse s (f <$> xs)) -- | Render a collection of elements layout-sensitively using given printer, -- inserting semicolons if necessary and respecting 'useBraces' and -- 'dontUseBraces' combinators. -- -- > useBraces $ sepSemi txt ["foo", "bar"] -- > == vlayout (txt "{ foo; bar }") (txt "foo\nbar") -- -- > dontUseBraces $ sepSemi txt ["foo", "bar"] -- > == vlayout (txt "foo; bar") (txt "foo\nbar") sepSemi :: -- | How to render an element (a -> R ()) -> -- | Elements to render [a] -> R () sepSemi f xs = vlayout singleLine multiLine where singleLine = do ub <- canUseBraces case xs of [] -> when ub $ txt "{}" xs' -> if ub then do txt "{" space sep (txt ";" >> space) (dontUseBraces . f) xs' space txt "}" else sep (txt ";" >> space) f xs' multiLine = sep newline (dontUseBraces . f) xs ---------------------------------------------------------------------------- -- Wrapping -- | 'BracketStyle' controlling how closing bracket is rendered. data BracketStyle = -- | Normal N | -- | Shifted one level S deriving (Eq, Show) -- | 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 inciIf (style == S) (txt close) ---------------------------------------------------------------------------- -- Literals -- | Print @,@. comma :: R () comma = txt "," -- | Delimiting combination with 'comma'. To be used with 'sep'. commaDel :: R () commaDel = comma >> breakpoint -- | Print @=@. Do not use @'txt' "="@. equals :: R () equals = interferingTxt "=" ormolu-0.1.2.0/src/Ormolu/Printer/Comments.hs0000644000000000000000000002275007346545000017174 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | Helpers for formatting of comments. This is low-level code, use -- "Ormolu.Printer.Combinators" unless you know what you are doing. module Ormolu.Printer.Comments ( spitPrecedingComments, spitFollowingComments, spitRemainingComments, spitCommentNow, spitCommentPending, ) where import Control.Monad import qualified Data.List.NonEmpty as NE import Data.Maybe (listToMaybe) import qualified Data.Text as T import Ormolu.Parser.CommentStream import Ormolu.Printer.Internal import SrcLoc ---------------------------------------------------------------------------- -- Top-level -- | Output all preceding comments for an element at given location. spitPrecedingComments :: -- | Span of the element to attach comments to RealSrcSpan -> R () spitPrecedingComments ref = do gotSome <- handleCommentSeries (spitPrecedingComment ref) when gotSome $ do lastMark <- getSpanMark -- Insert a blank line between the preceding comments and the thing -- after them if there was a blank line in the input. when (needsNewlineBefore ref lastMark) newline -- | Output all comments following an element at given location. spitFollowingComments :: -- | Span of the element to attach comments to RealSrcSpan -> R () spitFollowingComments ref = do trimSpanStream ref void $ handleCommentSeries (spitFollowingComment ref) -- | Output all remaining comments in the comment stream. spitRemainingComments :: R () spitRemainingComments = do -- Make sure we have a blank a line between the last definition and the -- trailing comments. newline void $ handleCommentSeries spitRemainingComment ---------------------------------------------------------------------------- -- Single-comment functions -- | Output a single preceding comment for an element at given location. spitPrecedingComment :: -- | Span of the element to attach comments to RealSrcSpan -> -- | Are we done? R Bool spitPrecedingComment ref = do mlastMark <- getSpanMark let p (L l _) = realSrcSpanEnd l <= realSrcSpanStart ref withPoppedComment p $ \l comment -> do lineSpans <- thisLineSpans let thisCommentLine = srcLocLine (realSrcSpanStart l) needsNewline = case listToMaybe lineSpans of Nothing -> False Just spn -> srcLocLine (realSrcSpanEnd spn) /= thisCommentLine when (needsNewline || needsNewlineBefore l mlastMark) newline spitCommentNow l comment if theSameLinePre l ref then space else newline -- | Output a comment that follows element at given location immediately on -- the same line, if there is any. spitFollowingComment :: -- | AST element to attach comments to RealSrcSpan -> -- | Are we done? R Bool spitFollowingComment ref = do mlastMark <- getSpanMark mnSpn <- nextEltSpan -- Get first enclosing span that is not equal to reference span, i.e. it's -- truly something enclosing the AST element. meSpn <- getEnclosingSpan (/= ref) withPoppedComment (commentFollowsElt ref mnSpn meSpn mlastMark) $ \l comment -> if theSameLinePost l ref then if isMultilineComment comment then space >> spitCommentNow l comment else spitCommentPending OnTheSameLine l comment else do when (needsNewlineBefore l mlastMark) $ registerPendingCommentLine OnNextLine "" spitCommentPending OnNextLine l comment -- | Output a single remaining comment from the comment stream. spitRemainingComment :: -- | Are we done? R Bool spitRemainingComment = do mlastMark <- getSpanMark withPoppedComment (const True) $ \l comment -> do when (needsNewlineBefore l mlastMark) newline spitCommentNow l comment newline ---------------------------------------------------------------------------- -- Helpers -- | Output series of comments. handleCommentSeries :: -- | Given location of previous comment, output the next comment -- returning 'True' if we're done R Bool -> -- | Whether we printed any comments R Bool handleCommentSeries f = go False where go gotSome = do done <- f if done then return gotSome else go True -- | Try to pop a comment using given predicate and if there is a comment -- matching the predicate, print it out. withPoppedComment :: -- | Comment predicate (RealLocated Comment -> Bool) -> -- | Printing function (RealSrcSpan -> Comment -> R ()) -> -- | Are we done? R Bool withPoppedComment p f = do r <- popComment p case r of Nothing -> return True Just (L l comment) -> False <$ f l comment -- | Determine if we need to insert a newline between current comment and -- last printed comment. needsNewlineBefore :: -- | Current comment span RealSrcSpan -> -- | Last printed comment span Maybe SpanMark -> Bool needsNewlineBefore _ (Just (HaddockSpan _ _)) = True needsNewlineBefore l mlastMark = case spanMarkSpan <$> mlastMark of Nothing -> False Just lastMark -> srcSpanStartLine l > srcSpanEndLine lastMark + 1 -- | Is the preceding comment and AST element are on the same line? theSameLinePre :: -- | Current comment span RealSrcSpan -> -- | AST element location RealSrcSpan -> Bool theSameLinePre l ref = srcSpanEndLine l == srcSpanStartLine ref -- | Is the following comment and AST element are on the same line? theSameLinePost :: -- | Current comment span RealSrcSpan -> -- | AST element location RealSrcSpan -> Bool theSameLinePost l ref = srcSpanStartLine l == srcSpanEndLine ref -- | Determine if given comment follows AST element. commentFollowsElt :: -- | Location of AST element RealSrcSpan -> -- | Location of next AST element Maybe RealSrcSpan -> -- | Location of enclosing AST element Maybe RealSrcSpan -> -- | Location of last comment in the series Maybe SpanMark -> -- | Comment to test RealLocated Comment -> Bool commentFollowsElt ref mnSpn meSpn mlastMark (L l comment) = -- A comment follows a AST element if all 4 conditions are satisfied: goesAfter && logicallyFollows && noEltBetween && (continuation || lastInEnclosing || supersedesParentElt) where -- 1) The comment starts after end of the AST element: goesAfter = realSrcSpanStart l >= realSrcSpanEnd ref -- 2) The comment logically belongs to the element, four cases: logicallyFollows = theSameLinePost l ref -- a) it's on the same line || continuation -- b) it's a continuation of a comment block || lastInEnclosing -- c) it's the last element in the enclosing construct -- 3) There is no other AST element between this element and the comment: noEltBetween = case mnSpn of Nothing -> True Just nspn -> realSrcSpanStart nspn >= realSrcSpanEnd l -- 4) Less obvious: if column of comment is closer to the start of -- enclosing element, it probably related to that parent element, not to -- the current child element. This rule is important because otherwise -- all comments would end up assigned to closest inner elements, and -- parent elements won't have a chance to get any comments assigned to -- them. This is not OK because comments will get indented according to -- the AST elements they are attached to. -- -- Skip this rule if the comment is a continuation of a comment block. supersedesParentElt = case meSpn of Nothing -> True Just espn -> let startColumn = srcLocCol . realSrcSpanStart in startColumn espn > startColumn ref || ( abs (startColumn espn - startColumn l) >= abs (startColumn ref - startColumn l) ) continuation = -- A comment is a continuation when it doesn't have non-whitespace -- lexemes in front of it and goes right after the previous comment. not (hasAtomsBefore comment) && ( case mlastMark of Just (HaddockSpan _ _) -> False Just (CommentSpan spn) -> srcSpanEndLine spn + 1 == srcSpanStartLine l _ -> False ) lastInEnclosing = case meSpn of -- When there is no enclosing element, return false Nothing -> False -- When there is an enclosing element, Just espn -> let -- Make sure that the comment is inside the enclosing element insideParent = realSrcSpanEnd l <= realSrcSpanEnd espn -- And check if the next element is outside of the parent nextOutsideParent = case mnSpn of Nothing -> True Just nspn -> realSrcSpanEnd espn < realSrcSpanStart nspn in insideParent && nextOutsideParent -- | Output a 'Comment' immediately. This is a low-level printing function. spitCommentNow :: RealSrcSpan -> Comment -> R () spitCommentNow spn comment = do sitcc . sequence_ . NE.intersperse newline . fmap (txt . T.pack) . unComment $ comment setSpanMark (CommentSpan spn) -- | Output a 'Comment' at the end of correct line or after it depending on -- 'CommentPosition'. Used for comments that may potentially follow on the -- same line as something we just rendered, but not immediately after it. spitCommentPending :: CommentPosition -> RealSrcSpan -> Comment -> R () spitCommentPending position spn comment = do let wrapper = case position of OnTheSameLine -> sitcc OnNextLine -> id wrapper . sequence_ . NE.toList . fmap (registerPendingCommentLine position . T.pack) . unComment $ comment setSpanMark (CommentSpan spn) ormolu-0.1.2.0/src/Ormolu/Printer/Internal.hs0000644000000000000000000004056107346545000017163 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} -- | In most cases import "Ormolu.Printer.Combinators" instead, these -- functions are the low-level building blocks and should not be used on -- their own. The 'R' monad is re-exported from "Ormolu.Printer.Combinators" -- as well. module Ormolu.Printer.Internal ( -- * The 'R' monad R, runR, -- * Internal functions txt, interferingTxt, atom, space, newline, useRecordDot, inci, sitcc, Layout (..), enterLayout, vlayout, getLayout, -- * Helpers for braces useBraces, dontUseBraces, canUseBraces, -- * Special helpers for comment placement CommentPosition (..), registerPendingCommentLine, trimSpanStream, nextEltSpan, popComment, getEnclosingSpan, withEnclosingSpan, thisLineSpans, -- * Stateful markers SpanMark (..), spanMarkSpan, HaddockStyle (..), setSpanMark, getSpanMark, -- * Annotations getAnns, ) where import Control.Monad.Reader import Control.Monad.State.Strict import Data.Bool (bool) import Data.Coerce import Data.Maybe (listToMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder import GHC import Ormolu.Parser.Anns import Ormolu.Parser.CommentStream import Ormolu.Printer.SpanStream import Ormolu.Utils (showOutputable) import Outputable (Outputable) ---------------------------------------------------------------------------- -- The 'R' monad -- | The 'R' monad hosts combinators that allow us to describe how to render -- AST. newtype R a = R (ReaderT RC (State SC) a) deriving (Functor, Applicative, Monad) -- | Reader context of 'R'. This should be used when we control rendering by -- enclosing certain expressions with wrappers. data RC = RC { -- | Indentation level, as the column index we need to start from after -- a newline if we break lines rcIndent :: !Int, -- | Current layout rcLayout :: Layout, -- | Spans of enclosing elements of AST rcEnclosingSpans :: [RealSrcSpan], -- | Collection of annotations rcAnns :: Anns, -- | Whether the last expression in the layout can use braces rcCanUseBraces :: Bool, -- | Whether the source could have used the record dot preprocessor rcUseRecDot :: Bool } -- | State context of 'R'. data SC = SC { -- | Index of the next column to render scColumn :: !Int, -- | Indentation level that was used for the current line scIndent :: !Int, -- | Rendered source code so far scBuilder :: Builder, -- | Span stream scSpanStream :: SpanStream, -- | Spans of atoms that have been printed on the current line so far scThisLineSpans :: [RealSrcSpan], -- | Comment stream scCommentStream :: CommentStream, -- | Pending comment lines (in reverse order) to be inserted before next -- newline, 'Int' is the indentation level scPendingComments :: ![(CommentPosition, Text)], -- | Whether to output a space before the next output scRequestedDelimiter :: !RequestedDelimiter, -- | An auxiliary marker for keeping track of last output element scSpanMark :: !(Maybe SpanMark) } -- | Make sure next output is delimited by one of the following. data RequestedDelimiter = -- | A space RequestedSpace | -- | A newline RequestedNewline | -- | Nothing RequestedNothing | -- | We just output a newline AfterNewline | -- | We haven't printed anything yet VeryBeginning deriving (Eq, Show) -- | 'Layout' options. data Layout = -- | Put everything on single line SingleLine | -- | Use multiple lines MultiLine deriving (Eq, Show) -- | Modes for rendering of pending comments. data CommentPosition = -- | Put the comment on the same line OnTheSameLine | -- | Put the comment on next line OnNextLine deriving (Eq, Show) -- | Run an 'R' monad. runR :: -- | Monad to run R () -> -- | Span stream SpanStream -> -- | Comment stream CommentStream -> -- | Annotations Anns -> -- | Use Record Dot Syntax Bool -> -- | Resulting rendition Text runR (R m) sstream cstream anns recDot = TL.toStrict . toLazyText . scBuilder $ execState (runReaderT m rc) sc where rc = RC { rcIndent = 0, rcLayout = MultiLine, rcEnclosingSpans = [], rcAnns = anns, rcCanUseBraces = False, rcUseRecDot = recDot } sc = SC { scColumn = 0, scIndent = 0, scBuilder = mempty, scSpanStream = sstream, scThisLineSpans = [], scCommentStream = cstream, scPendingComments = [], scRequestedDelimiter = VeryBeginning, scSpanMark = Nothing } ---------------------------------------------------------------------------- -- Internal functions -- | Type of the thing to output. Influences the primary low-level rendering -- function 'spit'. data SpitType = -- | Simple opaque text that breaks comment series. SimpleText | -- | Like 'SimpleText', but assume that when this text is inserted it -- will separate an 'Atom' and its pending comments, so insert an extra -- 'newline' in that case to force the pending comments and continue on -- a fresh line. InterferingText | -- | An atom that typically have span information in the AST and can -- have comments attached to it. Atom | -- | Used for rendering comment lines. CommentPart deriving (Show, Eq) -- | Output a fixed 'Text' fragment. The argument may not contain any line -- breaks. 'txt' is used to output all sorts of “fixed” bits of syntax like -- keywords and pipes @|@ in functional dependencies. -- -- To separate various bits of syntax with white space use 'space' instead -- of @'txt' " "@. To output 'Outputable' Haskell entities like numbers use -- 'atom'. txt :: -- | 'Text' to output Text -> R () txt = spit SimpleText -- | Similar to 'txt' but the text inserted this way is assumed to break the -- “link” between the preceding atom and its pending comments. interferingTxt :: -- | 'Text' to output Text -> R () interferingTxt = spit InterferingText -- | Output 'Outputable' fragment of AST. This can be used to output numeric -- literals and similar. Everything that doesn't have inner structure but -- does have an 'Outputable' instance. atom :: Outputable a => a -> R () atom = spit Atom . T.pack . showOutputable -- | Low-level non-public helper to define 'txt' and 'atom'. spit :: -- | Type of the thing to spit SpitType -> -- | 'Text' to output Text -> R () spit _ "" = return () spit stype text = do requestedDel <- R (gets scRequestedDelimiter) pendingComments <- R (gets scPendingComments) when (stype == InterferingText && not (null pendingComments)) newline case requestedDel of RequestedNewline -> do R . modify $ \sc -> sc { scRequestedDelimiter = RequestedNothing } case stype of CommentPart -> newlineRaw _ -> newline _ -> return () R $ do i <- asks rcIndent c <- gets scColumn closestEnclosing <- listToMaybe <$> asks rcEnclosingSpans let indentedTxt = spaces <> text spaces = T.replicate spacesN " " spacesN = if c == 0 then i else bool 0 1 (requestedDel == RequestedSpace) modify $ \sc -> sc { scBuilder = scBuilder sc <> fromText indentedTxt, scColumn = scColumn sc + T.length indentedTxt, scIndent = if c == 0 then i else scIndent sc, scThisLineSpans = let xs = scThisLineSpans sc in case stype of Atom -> case closestEnclosing of Nothing -> xs Just x -> x : xs _ -> xs, scRequestedDelimiter = RequestedNothing, scSpanMark = -- If there are pending comments, do not reset last comment -- location. if (stype == CommentPart) || (not . null . scPendingComments) sc then scSpanMark sc else Nothing } -- | This primitive /does not/ necessarily output a space. It just ensures -- that the next thing that will be printed on the same line will be -- separated by a single space from the previous output. Using this -- combinator twice results in at most one space. -- -- In practice this design prevents trailing white space and makes it hard -- to output more than one delimiting space in a row, which is what we -- usually want. space :: R () space = R . modify $ \sc -> sc { scRequestedDelimiter = case scRequestedDelimiter sc of RequestedNothing -> RequestedSpace other -> other } -- | Output a newline. First time 'newline' is used after some non-'newline' -- output it gets inserted immediately. Second use of 'newline' does not -- output anything but makes sure that the next non-white space output will -- be prefixed by a newline. Using 'newline' more than twice in a row has no -- effect. Also, using 'newline' at the very beginning has no effect, this -- is to avoid leading whitespace. -- -- Similarly to 'space', this design prevents trailing newlines and makes it -- hard to output more than one blank newline in a row. newline :: R () newline = do indent <- R (gets scIndent) cs <- reverse <$> R (gets scPendingComments) case cs of [] -> newlineRaw ((position, _) : _) -> do case position of OnTheSameLine -> space OnNextLine -> newlineRaw R . forM_ cs $ \(_, text) -> let modRC rc = rc { rcIndent = indent } R m = do unless (T.null text) $ spit CommentPart text newlineRaw in local modRC m R . modify $ \sc -> sc { scPendingComments = [] } -- | Low-level newline primitive. This one always just inserts a newline, no -- hooks can be attached. newlineRaw :: R () newlineRaw = R . modify $ \sc -> let requestedDel = scRequestedDelimiter sc builderSoFar = scBuilder sc in sc { scBuilder = case requestedDel of AfterNewline -> builderSoFar RequestedNewline -> builderSoFar VeryBeginning -> builderSoFar _ -> builderSoFar <> "\n", scColumn = 0, scIndent = 0, scThisLineSpans = [], scRequestedDelimiter = case scRequestedDelimiter sc of AfterNewline -> RequestedNewline RequestedNewline -> RequestedNewline VeryBeginning -> VeryBeginning _ -> AfterNewline } -- | Return 'True' if we should print record dot syntax. useRecordDot :: R Bool useRecordDot = R (asks rcUseRecDot) -- | Increase indentation level by one indentation step for the inner -- computation. 'inci' should be used when a part of code must be more -- indented relative to the parts outside of 'inci' in order for the output -- to be valid Haskell. When layout is single-line there is no obvious -- effect, but with multi-line layout correct indentation levels matter. inci :: R () -> R () inci (R m) = R (local modRC m) where modRC rc = rc { rcIndent = rcIndent rc + indentStep } -- | Set indentation level for the inner computation equal to current -- column. This makes sure that the entire inner block is uniformly -- \"shifted\" to the right. sitcc :: R () -> R () sitcc (R m) = do requestedDel <- R (gets scRequestedDelimiter) i <- R (asks rcIndent) c <- R (gets scColumn) let modRC rc = rc { rcIndent = max i (c + bool 0 1 (requestedDel == RequestedSpace)) } R (local modRC m) -- | Set 'Layout' for internal computation. enterLayout :: Layout -> R () -> R () enterLayout l (R m) = R (local modRC m) where modRC rc = rc { rcLayout = l } -- | Do one or another thing depending on current 'Layout'. vlayout :: -- | Single line R a -> -- | Multi line R a -> R a vlayout sline mline = do l <- getLayout case l of SingleLine -> sline MultiLine -> mline -- | Get current 'Layout'. getLayout :: R Layout getLayout = R (asks rcLayout) ---------------------------------------------------------------------------- -- Special helpers for comment placement -- | Register a comment line for outputting. It will be inserted right -- before next newline. When the comment goes after something else on the -- same line, a space will be inserted between preceding text and the -- comment when necessary. registerPendingCommentLine :: -- | Comment position CommentPosition -> -- | 'Text' to output Text -> R () registerPendingCommentLine position text = R $ do modify $ \sc -> sc { scPendingComments = (position, text) : scPendingComments sc } -- | Drop elements that begin before or at the same place as given -- 'SrcSpan'. trimSpanStream :: -- | Reference span RealSrcSpan -> R () trimSpanStream ref = do let leRef :: RealSrcSpan -> Bool leRef x = realSrcSpanStart x <= realSrcSpanStart ref R . modify $ \sc -> sc { scSpanStream = coerce (dropWhile leRef) (scSpanStream sc) } -- | Get location of next element in AST. nextEltSpan :: R (Maybe RealSrcSpan) nextEltSpan = listToMaybe . coerce <$> R (gets scSpanStream) -- | Pop a 'Comment' from the 'CommentStream' if given predicate is -- satisfied and there are comments in the stream. popComment :: (RealLocated Comment -> Bool) -> R (Maybe (RealLocated Comment)) popComment f = R $ do CommentStream cstream <- gets scCommentStream case cstream of [] -> return Nothing (x : xs) -> if f x then Just x <$ modify ( \sc -> sc { scCommentStream = CommentStream xs } ) else return Nothing -- | Get the first enclosing 'RealSrcSpan' that satisfies given predicate. getEnclosingSpan :: -- | Predicate to use (RealSrcSpan -> Bool) -> R (Maybe RealSrcSpan) getEnclosingSpan f = listToMaybe . filter f <$> R (asks rcEnclosingSpans) -- | Set 'RealSrcSpan' of enclosing span for the given computation. withEnclosingSpan :: RealSrcSpan -> R () -> R () withEnclosingSpan spn (R m) = R (local modRC m) where modRC rc = rc { rcEnclosingSpans = spn : rcEnclosingSpans rc } -- | Get spans on this line so far. thisLineSpans :: R [RealSrcSpan] thisLineSpans = R (gets scThisLineSpans) ---------------------------------------------------------------------------- -- Stateful markers -- | An auxiliary marker for keeping track of last output element. data SpanMark = -- | Haddock comment HaddockSpan HaddockStyle RealSrcSpan | -- | Non-haddock comment CommentSpan RealSrcSpan | -- | A statement in a do-block and such span StatementSpan RealSrcSpan -- | Project 'RealSrcSpan' from 'SpanMark'. spanMarkSpan :: SpanMark -> RealSrcSpan spanMarkSpan = \case HaddockSpan _ s -> s CommentSpan s -> s StatementSpan s -> s -- | Haddock string style. data HaddockStyle = -- | @-- |@ Pipe | -- | @-- ^@ Caret | -- | @-- *@ Asterisk Int | -- | @-- $@ Named String -- | Set span of last output comment. setSpanMark :: -- | Span mark to set SpanMark -> R () setSpanMark spnMark = R . modify $ \sc -> sc { scSpanMark = Just spnMark } -- | Get span of last output comment. getSpanMark :: R (Maybe SpanMark) getSpanMark = R (gets scSpanMark) ---------------------------------------------------------------------------- -- Annotations -- | For a given span return 'AnnKeywordId's associated with it. getAnns :: SrcSpan -> R [AnnKeywordId] getAnns spn = lookupAnns spn <$> R (asks rcAnns) ---------------------------------------------------------------------------- -- Helpers for braces -- | Make the inner computation use braces around single-line layouts. useBraces :: R () -> R () useBraces (R r) = R (local (\i -> i {rcCanUseBraces = True}) r) -- | Make the inner computation omit braces around single-line layouts. dontUseBraces :: R () -> R () dontUseBraces (R r) = R (local (\i -> i {rcCanUseBraces = False}) r) -- | Return 'True' if we can use braces in this context. canUseBraces :: R Bool canUseBraces = R (asks rcCanUseBraces) ---------------------------------------------------------------------------- -- Constants -- | Indentation step. indentStep :: Int indentStep = 2 ormolu-0.1.2.0/src/Ormolu/Printer/Meat/0000755000000000000000000000000007346545000015733 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Common.hs0000644000000000000000000001237007346545000017522 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -- | Rendering of commonly useful bits. module Ormolu.Printer.Meat.Common ( FamilyStyle (..), p_hsmodName, p_ieWrappedName, p_rdrName, doesNotNeedExtraParens, p_qualName, p_infixDefHelper, p_hsDocString, p_hsDocName, ) where import Control.Monad import Data.List (isPrefixOf) import qualified Data.Text as T import GHC hiding (GhcPs, IE) import Name (nameStableString) import OccName (OccName (..)) import Ormolu.Printer.Combinators import Ormolu.Utils -- | Data and type family style. data FamilyStyle = -- | Declarations in type classes Associated | -- | Top-level declarations Free p_hsmodName :: ModuleName -> R () p_hsmodName mname = do txt "module" space atom mname p_ieWrappedName :: IEWrappedName RdrName -> R () p_ieWrappedName = \case IEName x -> p_rdrName x IEPattern x -> do txt "pattern" space p_rdrName x IEType x -> do txt "type" space p_rdrName x -- | Render a @'Located' 'RdrName'@. p_rdrName :: Located RdrName -> R () p_rdrName l@(L spn _) = located l $ \x -> do ids <- getAnns spn let backticksWrapper = if AnnBackquote `elem` ids then backticks else id parensWrapper = if AnnOpenP `elem` ids then parens N else id singleQuoteWrapper = if AnnSimpleQuote `elem` ids then \y -> do txt "'" y else id m = case x of Unqual occName -> atom occName Qual mname occName -> p_qualName mname occName Orig _ occName -> -- This is used when GHC generates code that will be fed into -- the renamer (e.g. from deriving clauses), but where we want -- to say that something comes from given module which is not -- specified in the source code, e.g. @Prelude.map@. -- -- My current understanding is that the provided module name -- serves no purpose for us and can be safely ignored. atom occName Exact name -> atom name m' = backticksWrapper (singleQuoteWrapper m) if doesNotNeedExtraParens x then m' else parensWrapper m' -- | Whether given name should not have parentheses around it. This is used -- to detect e.g. tuples for which annotations will indicate parentheses, -- but the parentheses are already part of the symbol, so no extra layer of -- parentheses should be added. It also detects the [] literal. doesNotNeedExtraParens :: RdrName -> Bool doesNotNeedExtraParens = \case Exact name -> let s = nameStableString name in -- I'm not sure this "stable string" is stable enough, but it looks -- like this is the most robust way to tell if we're looking at -- exactly this piece of built-in syntax. ("$ghc-prim$GHC.Tuple$" `isPrefixOf` s) || ("$ghc-prim$GHC.Types$[]" `isPrefixOf` s) _ -> False p_qualName :: ModuleName -> OccName -> R () p_qualName mname occName = do atom mname txt "." atom occName -- | A helper for formatting infix constructions in lhs of definitions. p_infixDefHelper :: -- | Whether to format in infix style Bool -> -- | Whether to bump indentation for arguments Bool -> -- | How to print the operator\/name R () -> -- | How to print the arguments [R ()] -> R () p_infixDefHelper isInfix indentArgs name args = case (isInfix, args) of (True, p0 : p1 : ps) -> do let parens' = if null ps then id else parens N parens' $ do p0 breakpoint inci . sitcc $ do name space p1 unless (null ps) . inciIf indentArgs $ do breakpoint sitcc (sep breakpoint sitcc ps) (_, ps) -> do name unless (null ps) $ do breakpoint inciIf indentArgs $ sitcc (sep breakpoint sitcc args) -- | Print a Haddock. p_hsDocString :: -- | Haddock style HaddockStyle -> -- | Finish the doc string with a newline Bool -> -- | The doc string to render LHsDocString -> R () p_hsDocString hstyle needsNewline (L l str) = do let isCommentSpan = \case HaddockSpan _ _ -> True CommentSpan _ -> True _ -> False goesAfterComment <- maybe False isCommentSpan <$> getSpanMark -- Make sure the Haddock is separated by a newline from other comments. when goesAfterComment newline forM_ (zip (splitDocString str) (True : repeat False)) $ \(x, isFirst) -> do if isFirst then case hstyle of Pipe -> txt "-- |" Caret -> txt "-- ^" Asterisk n -> txt ("-- " <> T.replicate n "*") Named name -> p_hsDocName name else newline >> txt "--" space unless (T.null x) (txt x) when needsNewline newline case l of UnhelpfulSpan _ -> -- It's often the case that the comment itself doesn't have a span -- attached to it and instead its location can be obtained from -- nearest enclosing span. getEnclosingSpan (const True) >>= mapM_ (setSpanMark . HaddockSpan hstyle) RealSrcSpan spn -> setSpanMark (HaddockSpan hstyle spn) -- | Print anchor of named doc section. p_hsDocName :: String -> R () p_hsDocName name = txt ("-- $" <> T.pack name) ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration.hs0000644000000000000000000002756207346545000020530 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -- | Rendering of declarations. module Ormolu.Printer.Meat.Declaration ( p_hsDecls, p_hsDeclsRespectGrouping, ) where import Data.List (sort) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import GHC hiding (InlinePragma) import OccName (occNameFS) import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Annotation import Ormolu.Printer.Meat.Declaration.Class import Ormolu.Printer.Meat.Declaration.Data import Ormolu.Printer.Meat.Declaration.Default import Ormolu.Printer.Meat.Declaration.Foreign import Ormolu.Printer.Meat.Declaration.Instance import Ormolu.Printer.Meat.Declaration.RoleAnnotation import Ormolu.Printer.Meat.Declaration.Rule import Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Declaration.Splice import Ormolu.Printer.Meat.Declaration.Type import Ormolu.Printer.Meat.Declaration.TypeFamily import Ormolu.Printer.Meat.Declaration.Value import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Printer.Meat.Type import Ormolu.Utils data UserGrouping = -- | Always put newlines where we think they should be Disregard | -- | Respect user preferences regarding grouping Respect deriving (Eq, Show) p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R () p_hsDecls = p_hsDecls' Disregard -- | Like 'p_hsDecls' but respects user choices regarding grouping. If the -- user omits newlines between declarations, we also omit them in most -- cases, except when said declarations have associated Haddocks. -- -- Does some normalization (compress subsequent newlines into a single one) p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R () p_hsDeclsRespectGrouping = p_hsDecls' Respect p_hsDecls' :: UserGrouping -> FamilyStyle -> [LHsDecl GhcPs] -> R () p_hsDecls' grouping style decls = sepSemi id $ -- Return a list of rendered declarations, adding a newline to separate -- groups. case groupDecls decls of [] -> [] (x : xs) -> renderGroup x ++ concat (zipWith renderGroupWithPrev (x : xs) xs) where renderGroup = NE.toList . fmap (located' $ dontUseBraces . p_hsDecl style) renderGroupWithPrev prev curr = -- We can omit a blank line when the user didn't add one, but we must -- ensure we always add blank lines around documented declarations case grouping of Disregard -> breakpoint : renderGroup curr Respect -> if separatedByBlankNE getLoc prev curr || isDocumented prev || isDocumented curr then breakpoint : renderGroup curr else renderGroup curr -- | Is a declaration group documented? isDocumented :: NonEmpty (LHsDecl GhcPs) -> Bool isDocumented = any (isHaddock . unLoc) where isHaddock DocNext = True isHaddock DocPrev = True isHaddock _ = False -- | Group relevant declarations together. groupDecls :: [LHsDecl GhcPs] -> [NonEmpty (LHsDecl GhcPs)] groupDecls [] = [] groupDecls (l@(L _ DocNext) : xs) = -- If the first element is a doc string for next element, just include it -- in the next block: case groupDecls xs of [] -> [l :| []] (x : xs') -> (l <| x) : xs' groupDecls (header : xs) = let (grp, rest) = flip span (zip (header : xs) xs) $ \(previous, current) -> let relevantToHdr = groupedDecls header current relevantToPrev = groupedDecls previous current isDeclSeries = declSeries previous current in isDeclSeries || relevantToHdr || relevantToPrev in (header :| map snd grp) : groupDecls (map snd rest) p_hsDecl :: FamilyStyle -> HsDecl GhcPs -> R () p_hsDecl style = \case TyClD NoExtField x -> p_tyClDecl style x ValD NoExtField x -> p_valDecl x SigD NoExtField x -> p_sigDecl x InstD NoExtField x -> p_instDecl style x DerivD NoExtField x -> p_derivDecl x DefD NoExtField x -> p_defaultDecl x ForD NoExtField x -> p_foreignDecl x WarningD NoExtField x -> p_warnDecls x AnnD NoExtField x -> p_annDecl x RuleD NoExtField x -> p_ruleDecls x SpliceD NoExtField x -> p_spliceDecl x DocD NoExtField docDecl -> case docDecl of DocCommentNext str -> p_hsDocString Pipe False (noLoc str) DocCommentPrev str -> p_hsDocString Caret False (noLoc str) DocCommentNamed name str -> p_hsDocString (Named name) False (noLoc str) DocGroup n str -> p_hsDocString (Asterisk n) False (noLoc str) RoleAnnotD NoExtField x -> p_roleAnnot x KindSigD NoExtField s -> p_standaloneKindSig s XHsDecl x -> noExtCon x p_tyClDecl :: FamilyStyle -> TyClDecl GhcPs -> R () p_tyClDecl style = \case FamDecl NoExtField x -> p_famDecl style x SynDecl {..} -> p_synDecl tcdLName tcdFixity tcdTyVars tcdRhs DataDecl {..} -> p_dataDecl Associated tcdLName (tyVarsToTypes tcdTyVars) tcdFixity tcdDataDefn ClassDecl {..} -> p_classDecl tcdCtxt tcdLName tcdTyVars tcdFixity tcdFDs tcdSigs tcdMeths tcdATs tcdATDefs tcdDocs XTyClDecl x -> noExtCon x p_instDecl :: FamilyStyle -> InstDecl GhcPs -> R () p_instDecl style = \case ClsInstD NoExtField x -> p_clsInstDecl x TyFamInstD NoExtField x -> p_tyFamInstDecl style x DataFamInstD NoExtField x -> p_dataFamInstDecl style x XInstDecl x -> noExtCon x p_derivDecl :: DerivDecl GhcPs -> R () p_derivDecl = \case d@DerivDecl {} -> p_standaloneDerivDecl d XDerivDecl x -> noExtCon x -- | Determine if these declarations should be grouped together. groupedDecls :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool groupedDecls (L l_x x') (L l_y y') = case (x', y') of (TypeSignature ns, FunctionBody ns') -> ns `intersects` ns' (TypeSignature ns, DefaultSignature ns') -> ns `intersects` ns' (DefaultSignature ns, TypeSignature ns') -> ns `intersects` ns' (DefaultSignature ns, FunctionBody ns') -> ns `intersects` ns' (x, FunctionBody ns) | Just ns' <- isPragma x -> ns `intersects` ns' (FunctionBody ns, x) | Just ns' <- isPragma x -> ns `intersects` ns' (x, DataDeclaration n) | Just ns <- isPragma x -> n `elem` ns (DataDeclaration n, x) | Just ns <- isPragma x -> let f = occNameFS . rdrNameOcc in f n `elem` map f ns (x, y) | Just ns <- isPragma x, Just ns' <- isPragma y -> ns `intersects` ns' (x, TypeSignature ns) | Just ns' <- isPragma x -> ns `intersects` ns' (TypeSignature ns, x) | Just ns' <- isPragma x -> ns `intersects` ns' (PatternSignature ns, Pattern n) -> n `elem` ns (KindSignature n, DataDeclaration n') -> n == n' (KindSignature n, ClassDeclaration n') -> n == n' (KindSignature n, FamilyDeclaration n') -> n == n' -- Special case for TH splices, we look at locations (Splice, Splice) -> not (separatedByBlank id l_x l_y) -- This looks only at Haddocks, normal comments are handled elsewhere (DocNext, _) -> True (_, DocPrev) -> True _ -> False -- | Detect declaration series that should not have blanks between them. declSeries :: LHsDecl GhcPs -> LHsDecl GhcPs -> Bool declSeries (L _ x) (L _ y) = case (x, y) of ( SigD NoExtField (TypeSig NoExtField _ _), SigD NoExtField (TypeSig NoExtField _ _) ) -> True _ -> False intersects :: Ord a => [a] -> [a] -> Bool intersects a b = go (sort a) (sort b) where go :: Ord a => [a] -> [a] -> Bool go _ [] = False go [] _ = False go (x : xs) (y : ys) | x < y = go xs (y : ys) | x > y = go (x : xs) ys | otherwise = True isPragma :: HsDecl GhcPs -> Maybe [RdrName] isPragma = \case InlinePragma n -> Just [n] SpecializePragma n -> Just [n] SCCPragma n -> Just [n] AnnTypePragma n -> Just [n] AnnValuePragma n -> Just [n] WarningPragma n -> Just n _ -> Nothing -- Declarations that do not refer to names pattern Splice :: HsDecl GhcPs pattern Splice <- SpliceD NoExtField (SpliceDecl NoExtField _ _) -- Declarations referring to a single name pattern InlinePragma, SpecializePragma, SCCPragma, AnnTypePragma, AnnValuePragma, Pattern, DataDeclaration, ClassDeclaration, KindSignature, FamilyDeclaration :: RdrName -> HsDecl GhcPs pattern InlinePragma n <- SigD NoExtField (InlineSig NoExtField (L _ n) _) pattern SpecializePragma n <- SigD NoExtField (SpecSig NoExtField (L _ n) _ _) pattern SCCPragma n <- SigD NoExtField (SCCFunSig NoExtField _ (L _ n) _) pattern AnnTypePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (TypeAnnProvenance (L _ n)) _) pattern AnnValuePragma n <- AnnD NoExtField (HsAnnotation NoExtField _ (ValueAnnProvenance (L _ n)) _) pattern Pattern n <- ValD NoExtField (PatSynBind NoExtField (PSB _ (L _ n) _ _ _)) pattern DataDeclaration n <- TyClD NoExtField (DataDecl NoExtField (L _ n) _ _ _) pattern ClassDeclaration n <- TyClD NoExtField (ClassDecl NoExtField _ (L _ n) _ _ _ _ _ _ _ _) pattern KindSignature n <- KindSigD NoExtField (StandaloneKindSig NoExtField (L _ n) _) pattern FamilyDeclaration n <- TyClD NoExtField (FamDecl NoExtField (FamilyDecl NoExtField _ (L _ n) _ _ _ _)) -- Declarations which can refer to multiple names pattern TypeSignature, DefaultSignature, FunctionBody, PatternSignature, WarningPragma :: [RdrName] -> HsDecl GhcPs pattern TypeSignature n <- (sigRdrNames -> Just n) pattern DefaultSignature n <- (defSigRdrNames -> Just n) pattern FunctionBody n <- (funRdrNames -> Just n) pattern PatternSignature n <- (patSigRdrNames -> Just n) pattern WarningPragma n <- (warnSigRdrNames -> Just n) pattern DocNext, DocPrev :: HsDecl GhcPs pattern DocNext <- (DocD NoExtField (DocCommentNext _)) pattern DocPrev <- (DocD NoExtField (DocCommentPrev _)) sigRdrNames :: HsDecl GhcPs -> Maybe [RdrName] sigRdrNames (SigD NoExtField (TypeSig NoExtField ns _)) = Just $ map unLoc ns sigRdrNames (SigD NoExtField (ClassOpSig NoExtField _ ns _)) = Just $ map unLoc ns sigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns sigRdrNames _ = Nothing defSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName] defSigRdrNames (SigD NoExtField (ClassOpSig NoExtField True ns _)) = Just $ map unLoc ns defSigRdrNames _ = Nothing funRdrNames :: HsDecl GhcPs -> Maybe [RdrName] funRdrNames (ValD NoExtField (FunBind NoExtField (L _ n) _ _ _)) = Just [n] funRdrNames (ValD NoExtField (PatBind NoExtField (L _ n) _ _)) = Just $ patBindNames n funRdrNames _ = Nothing patSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName] patSigRdrNames (SigD NoExtField (PatSynSig NoExtField ns _)) = Just $ map unLoc ns patSigRdrNames _ = Nothing warnSigRdrNames :: HsDecl GhcPs -> Maybe [RdrName] warnSigRdrNames (WarningD NoExtField (Warnings NoExtField _ ws)) = Just $ flip concatMap ws $ \case L _ (Warning NoExtField ns _) -> map unLoc ns L _ (XWarnDecl x) -> noExtCon x warnSigRdrNames _ = Nothing patBindNames :: Pat GhcPs -> [RdrName] patBindNames (TuplePat NoExtField ps _) = concatMap (patBindNames . unLoc) ps patBindNames (VarPat NoExtField (L _ n)) = [n] patBindNames (WildPat NoExtField) = [] patBindNames (LazyPat NoExtField (L _ p)) = patBindNames p patBindNames (BangPat NoExtField (L _ p)) = patBindNames p patBindNames (ParPat NoExtField (L _ p)) = patBindNames p patBindNames (ListPat NoExtField ps) = concatMap (patBindNames . unLoc) ps patBindNames (AsPat NoExtField (L _ n) (L _ p)) = n : patBindNames p patBindNames (SumPat NoExtField (L _ p) _ _) = patBindNames p patBindNames (ViewPat NoExtField _ (L _ p)) = patBindNames p patBindNames (SplicePat NoExtField _) = [] patBindNames (LitPat NoExtField _) = [] patBindNames (SigPat _ (L _ p) _) = patBindNames p patBindNames (NPat NoExtField _ _ _) = [] patBindNames (NPlusKPat NoExtField (L _ n) _ _ _ _) = [n] patBindNames (ConPatIn _ d) = concatMap (patBindNames . unLoc) (hsConPatArgs d) patBindNames ConPatOut {} = notImplemented "ConPatOut" -- created by renamer patBindNames (CoPat NoExtField _ p _) = patBindNames p patBindNames (XPat x) = noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration.hs-boot0000644000000000000000000000044607346545000021461 0ustar0000000000000000module Ormolu.Printer.Meat.Declaration ( p_hsDecls, p_hsDeclsRespectGrouping, ) where import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common p_hsDecls :: FamilyStyle -> [LHsDecl GhcPs] -> R () p_hsDeclsRespectGrouping :: FamilyStyle -> [LHsDecl GhcPs] -> R () ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/0000755000000000000000000000000007346545000020160 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Annotation.hs0000644000000000000000000000126307346545000022630 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.Printer.Meat.Declaration.Annotation ( p_annDecl, ) where import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Value p_annDecl :: AnnDecl GhcPs -> R () p_annDecl = \case HsAnnotation NoExtField _ annProv expr -> pragma "ANN" . inci $ do p_annProv annProv breakpoint located expr p_hsExpr XAnnDecl x -> noExtCon x p_annProv :: AnnProvenance (IdP GhcPs) -> R () p_annProv = \case ValueAnnProvenance name -> p_rdrName name TypeAnnProvenance name -> txt "type" >> space >> p_rdrName name ModuleAnnProvenance -> txt "module" ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Class.hs0000644000000000000000000000600507346545000021562 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of type class declarations. module Ormolu.Printer.Meat.Declaration.Class ( p_classDecl, ) where import Class import Control.Arrow import Control.Monad import Data.Foldable import Data.List (sortOn) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Type p_classDecl :: LHsContext GhcPs -> Located RdrName -> LHsQTyVars GhcPs -> LexicalFixity -> [Located (FunDep (Located RdrName))] -> [LSig GhcPs] -> LHsBinds GhcPs -> [LFamilyDecl GhcPs] -> [LTyFamDefltDecl GhcPs] -> [LDocDecl] -> R () p_classDecl ctx name HsQTvs {..} fixity fdeps csigs cdefs cats catdefs cdocs = do let variableSpans = getLoc <$> hsq_explicit signatureSpans = getLoc name : variableSpans dependencySpans = getLoc <$> fdeps combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans) -- GHC's AST does not necessarily store each kind of element in source -- location order. This happens because different declarations are stored -- in different lists. Consequently, to get all the declarations in proper -- order, they need to be manually sorted. sigs = (getLoc &&& fmap (SigD NoExtField)) <$> csigs vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cdefs tyFams = (getLoc &&& fmap (TyClD NoExtField . FamDecl NoExtField)) <$> cats docs = (getLoc &&& fmap (DocD NoExtField)) <$> cdocs tyFamDefs = ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField) ) <$> catdefs allDecls = snd <$> sortOn fst (sigs <> vals <> tyFams <> tyFamDefs <> docs) txt "class" switchLayout combinedSpans $ do breakpoint inci $ do p_classContext ctx switchLayout signatureSpans $ p_infixDefHelper (isInfix fixity) True (p_rdrName name) (located' p_hsTyVarBndr <$> hsq_explicit) inci (p_classFundeps fdeps) unless (null allDecls) $ do breakpoint txt "where" unless (null allDecls) $ do breakpoint -- Ensure whitespace is added after where clause. inci (p_hsDeclsRespectGrouping Associated allDecls) p_classDecl _ _ (XLHsQTyVars c) _ _ _ _ _ _ _ = noExtCon c p_classContext :: LHsContext GhcPs -> R () p_classContext ctx = unless (null (unLoc ctx)) $ do located ctx p_hsContext space txt "=>" breakpoint p_classFundeps :: [Located (FunDep (Located RdrName))] -> R () p_classFundeps fdeps = unless (null fdeps) $ do breakpoint txt "|" space inci $ sep commaDel (sitcc . located' p_funDep) fdeps p_funDep :: FunDep (Located RdrName) -> R () p_funDep (before, after) = do sep space p_rdrName before space txt "->" space sep space p_rdrName after ---------------------------------------------------------------------------- -- Helpers isInfix :: LexicalFixity -> Bool isInfix = \case Infix -> True Prefix -> False ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Data.hs0000644000000000000000000001556107346545000021375 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Renedring of data type declarations. module Ormolu.Printer.Meat.Declaration.Data ( p_dataDecl, ) where import Control.Monad import Data.Maybe (isJust, maybeToList) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type import Ormolu.Utils p_dataDecl :: -- | Whether to format as data family FamilyStyle -> -- | Type constructor Located RdrName -> -- | Type patterns [LHsType GhcPs] -> -- | Lexical fixity LexicalFixity -> -- | Data definition HsDataDefn GhcPs -> R () p_dataDecl style name tpats fixity HsDataDefn {..} = do txt $ case dd_ND of NewType -> "newtype" DataType -> "data" txt $ case style of Associated -> mempty Free -> " instance" let constructorSpans = getLoc name : fmap getLoc tpats switchLayout constructorSpans $ do breakpoint inci $ p_infixDefHelper (isInfix fixity) True (p_rdrName name) (located' p_hsType <$> tpats) case dd_kindSig of Nothing -> return () Just k -> do space txt "::" space located k p_hsType let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons unless (null dd_cons) $ if gadt then inci $ do switchLayout constructorSpans $ do breakpoint txt "where" breakpoint sepSemi (located' (p_conDecl False)) dd_cons else switchLayout (getLoc name : (getLoc <$> dd_cons)) . inci $ do let singleConstRec = isSingleConstRec dd_cons if singleConstRec then space else if hasHaddocks dd_cons then newline else breakpoint equals space layout <- getLayout let s = if layout == MultiLine || hasHaddocks dd_cons then newline >> txt "|" >> space else space >> txt "|" >> space sitcc' = if singleConstRec then id else sitcc sep s (sitcc' . located' (p_conDecl singleConstRec)) dd_cons unless (null $ unLoc dd_derivs) breakpoint inci . located dd_derivs $ \xs -> sep newline (located' p_hsDerivingClause) xs p_dataDecl _ _ _ _ (XHsDataDefn x) = noExtCon x p_conDecl :: Bool -> ConDecl GhcPs -> R () p_conDecl singleConstRec = \case ConDeclGADT {..} -> do mapM_ (p_hsDocString Pipe True) con_doc let conDeclSpn = fmap getLoc con_names <> [getLoc con_forall] <> conTyVarsSpans con_qvars <> maybeToList (fmap getLoc con_mb_cxt) <> conArgsSpans con_args switchLayout conDeclSpn $ do case con_names of [] -> return () (c : cs) -> do p_rdrName c unless (null cs) . inci $ do commaDel sep commaDel p_rdrName cs inci $ do space txt "::" let interArgBreak = if hasDocStrings (unLoc con_res_ty) then newline else breakpoint interArgBreak when (unLoc con_forall) $ do p_forallBndrs ForallInvis p_hsTyVarBndr (hsq_explicit con_qvars) interArgBreak forM_ con_mb_cxt p_lhsContext case con_args of PrefixCon xs -> do sep breakpoint (located' p_hsType) xs unless (null xs) $ do space txt "->" breakpoint RecCon l -> do located l p_conDeclFields unless (null $ unLoc l) $ do space txt "->" breakpoint InfixCon _ _ -> notImplemented "InfixCon" p_hsType (unLoc con_res_ty) ConDeclH98 {..} -> do mapM_ (p_hsDocString Pipe True) con_doc let conDeclWithContextSpn = [getLoc con_forall] <> fmap getLoc con_ex_tvs <> maybeToList (fmap getLoc con_mb_cxt) <> conDeclSpn conDeclSpn = getLoc con_name : conArgsSpans con_args switchLayout conDeclWithContextSpn $ do when (unLoc con_forall) $ do p_forallBndrs ForallInvis p_hsTyVarBndr con_ex_tvs breakpoint forM_ con_mb_cxt p_lhsContext switchLayout conDeclSpn $ case con_args of PrefixCon xs -> do p_rdrName con_name unless (null xs) breakpoint inci . sitcc $ sep breakpoint (sitcc . located' p_hsTypePostDoc) xs RecCon l -> do p_rdrName con_name breakpoint inciIf (not singleConstRec) (located l p_conDeclFields) InfixCon x y -> do located x p_hsType breakpoint inci $ do p_rdrName con_name space located y p_hsType XConDecl x -> noExtCon x conArgsSpans :: HsConDeclDetails GhcPs -> [SrcSpan] conArgsSpans = \case PrefixCon xs -> getLoc <$> xs RecCon l -> [getLoc l] InfixCon x y -> [getLoc x, getLoc y] conTyVarsSpans :: LHsQTyVars GhcPs -> [SrcSpan] conTyVarsSpans = \case HsQTvs {..} -> getLoc <$> hsq_explicit XLHsQTyVars x -> noExtCon x p_lhsContext :: LHsContext GhcPs -> R () p_lhsContext = \case L _ [] -> pure () ctx -> do located ctx p_hsContext space txt "=>" breakpoint isGadt :: ConDecl GhcPs -> Bool isGadt = \case ConDeclGADT {} -> True ConDeclH98 {} -> False XConDecl {} -> False p_hsDerivingClause :: HsDerivingClause GhcPs -> R () p_hsDerivingClause HsDerivingClause {..} = do txt "deriving" let derivingWhat = located deriv_clause_tys $ \case [] -> txt "()" xs -> parens N $ sep commaDel (sitcc . located' p_hsType . hsib_body) xs space case deriv_clause_strategy of Nothing -> do breakpoint inci derivingWhat Just (L _ a) -> case a of StockStrategy -> do txt "stock" breakpoint inci derivingWhat AnyclassStrategy -> do txt "anyclass" breakpoint inci derivingWhat NewtypeStrategy -> do txt "newtype" breakpoint inci derivingWhat ViaStrategy HsIB {..} -> do breakpoint inci $ do derivingWhat breakpoint txt "via" space located hsib_body p_hsType ViaStrategy (XHsImplicitBndrs x) -> noExtCon x p_hsDerivingClause (XHsDerivingClause x) = noExtCon x ---------------------------------------------------------------------------- -- Helpers isInfix :: LexicalFixity -> Bool isInfix = \case Infix -> True Prefix -> False isSingleConstRec :: [LConDecl GhcPs] -> Bool isSingleConstRec [(L _ ConDeclH98 {..})] = case con_args of RecCon _ -> True _ -> False isSingleConstRec _ = False hasHaddocks :: [LConDecl GhcPs] -> Bool hasHaddocks = any (f . unLoc) where f ConDeclH98 {..} = isJust con_doc f _ = False ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Default.hs0000644000000000000000000000070607346545000022103 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.Printer.Meat.Declaration.Default ( p_defaultDecl, ) where import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Type p_defaultDecl :: DefaultDecl GhcPs -> R () p_defaultDecl = \case DefaultDecl NoExtField ts -> do txt "default" breakpoint inci . parens N $ sep commaDel (sitcc . located' p_hsType) ts XDefaultDecl x -> noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Foreign.hs0000644000000000000000000000414707346545000022113 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.Printer.Meat.Declaration.Foreign ( p_foreignDecl, ) where import BasicTypes import Control.Monad import Data.Text import ForeignCall import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature p_foreignDecl :: ForeignDecl GhcPs -> R () p_foreignDecl = \case fd@ForeignImport {fd_fi} -> do p_foreignImport fd_fi p_foreignTypeSig fd fd@ForeignExport {fd_fe} -> do p_foreignExport fd_fe p_foreignTypeSig fd XForeignDecl x -> noExtCon x -- | Printer for the last part of an import\/export, which is function name -- and type signature. p_foreignTypeSig :: ForeignDecl GhcPs -> R () p_foreignTypeSig fd = do breakpoint inci . switchLayout [ getLoc (fd_name fd), (getLoc . hsib_body . fd_sig_ty) fd ] $ do p_rdrName (fd_name fd) p_typeAscription (HsWC NoExtField (fd_sig_ty fd)) -- | Printer for 'ForeignImport'. -- -- These have the form: -- -- > foreign import callingConvention [safety] [identifier] -- -- We need to check whether the safety has a good source, span, as it -- defaults to 'PlaySafe' if you don't have anything in the source. -- -- We also layout the identifier using the 'SourceText', because printing -- with the other two fields of 'CImport' is very complicated. See the -- 'Outputable' instance of 'ForeignImport' for details. p_foreignImport :: ForeignImport -> R () p_foreignImport (CImport cCallConv safety _ _ sourceText) = do txt "foreign import" space located cCallConv atom -- Need to check for 'noLoc' for the 'safe' annotation when (isGoodSrcSpan $ getLoc safety) (space >> atom safety) located sourceText p_sourceText p_foreignExport :: ForeignExport -> R () p_foreignExport (CExport (L loc (CExportStatic _ _ cCallConv)) sourceText) = do txt "foreign export" space located (L loc cCallConv) atom located sourceText p_sourceText p_sourceText :: SourceText -> R () p_sourceText = \case NoSourceText -> pure () SourceText s -> space >> txt (pack s) ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Instance.hs0000644000000000000000000001042307346545000022260 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Type class, type family, and data family instance declarations. module Ormolu.Printer.Meat.Declaration.Instance ( p_clsInstDecl, p_tyFamInstDecl, p_dataFamInstDecl, p_standaloneDerivDecl, ) where import BasicTypes import Control.Arrow import Control.Monad import Data.Foldable import Data.List (sortOn) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Data import Ormolu.Printer.Meat.Declaration.TypeFamily import Ormolu.Printer.Meat.Type import Ormolu.Utils p_standaloneDerivDecl :: DerivDecl GhcPs -> R () p_standaloneDerivDecl DerivDecl {..} = do let typesAfterInstance = located (hsib_body (hswc_body deriv_type)) p_hsType instTypes toIndent = inci $ do txt "instance" breakpoint match_overlap_mode deriv_overlap_mode breakpoint inciIf toIndent typesAfterInstance txt "deriving" space case deriv_strategy of Nothing -> instTypes False Just (L _ a) -> case a of StockStrategy -> do txt "stock " instTypes False AnyclassStrategy -> do txt "anyclass " instTypes False NewtypeStrategy -> do txt "newtype " instTypes False ViaStrategy HsIB {..} -> do txt "via" breakpoint inci (located hsib_body p_hsType) breakpoint instTypes True ViaStrategy (XHsImplicitBndrs x) -> noExtCon x p_standaloneDerivDecl (XDerivDecl _) = notImplemented "XDerivDecl" p_clsInstDecl :: ClsInstDecl GhcPs -> R () p_clsInstDecl = \case ClsInstDecl {..} -> do txt "instance" case cid_poly_ty of HsIB {..} -> do -- GHC's AST does not necessarily store each kind of element in source -- location order. This happens because different declarations are stored in -- different lists. Consequently, to get all the declarations in proper -- order, they need to be manually sorted. let sigs = (getLoc &&& fmap (SigD NoExtField)) <$> cid_sigs vals = (getLoc &&& fmap (ValD NoExtField)) <$> toList cid_binds tyFamInsts = ( getLoc &&& fmap (InstD NoExtField . TyFamInstD NoExtField) ) <$> cid_tyfam_insts dataFamInsts = ( getLoc &&& fmap (InstD NoExtField . DataFamInstD NoExtField) ) <$> cid_datafam_insts allDecls = snd <$> sortOn fst (sigs <> vals <> tyFamInsts <> dataFamInsts) located hsib_body $ \x -> do breakpoint inci $ do match_overlap_mode cid_overlap_mode breakpoint p_hsType x unless (null allDecls) $ do breakpoint txt "where" unless (null allDecls) . inci $ do -- Ensure whitespace is added after where clause. breakpoint dontUseBraces $ p_hsDeclsRespectGrouping Associated allDecls XHsImplicitBndrs x -> noExtCon x XClsInstDecl x -> noExtCon x p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R () p_tyFamInstDecl style = \case TyFamInstDecl {..} -> do txt $ case style of Associated -> "type" Free -> "type instance" breakpoint inci (p_tyFamInstEqn tfid_eqn) p_dataFamInstDecl :: FamilyStyle -> DataFamInstDecl GhcPs -> R () p_dataFamInstDecl style = \case DataFamInstDecl {dfid_eqn = HsIB {hsib_body = FamEqn {..}}} -> p_dataDecl style feqn_tycon (map typeArgToType feqn_pats) feqn_fixity feqn_rhs DataFamInstDecl {dfid_eqn = HsIB {hsib_body = XFamEqn {}}} -> notImplemented "XFamEqn" DataFamInstDecl {dfid_eqn = XHsImplicitBndrs {}} -> notImplemented "XHsImplicitBndrs" match_overlap_mode :: Maybe (Located OverlapMode) -> R () -> R () match_overlap_mode overlap_mode layoutStrategy = case unLoc <$> overlap_mode of Just Overlappable {} -> do txt "{-# OVERLAPPABLE #-}" layoutStrategy Just Overlapping {} -> do txt "{-# OVERLAPPING #-}" layoutStrategy Just Overlaps {} -> do txt "{-# OVERLAPS #-}" layoutStrategy Just Incoherent {} -> do txt "{-# INCOHERENT #-}" layoutStrategy _ -> pure () ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/RoleAnnotation.hs0000644000000000000000000000160707346545000023454 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} -- | Rendering of Role annotation declarations. module Ormolu.Printer.Meat.Declaration.RoleAnnotation ( p_roleAnnot, ) where import CoAxiom import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common p_roleAnnot :: RoleAnnotDecl GhcPs -> R () p_roleAnnot = \case RoleAnnotDecl NoExtField l_name anns -> p_roleAnnot' l_name anns XRoleAnnotDecl x -> noExtCon x p_roleAnnot' :: Located RdrName -> [Located (Maybe Role)] -> R () p_roleAnnot' l_name anns = do txt "type role" breakpoint inci $ do p_rdrName l_name breakpoint let p_role' = maybe (txt "_") p_role inci . sitcc $ sep breakpoint (sitcc . located' p_role') anns p_role :: Role -> R () p_role = \case Nominal -> txt "nominal" Representational -> txt "representational" Phantom -> txt "phantom" ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Rule.hs0000644000000000000000000000326007346545000021424 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.Printer.Meat.Declaration.Rule ( p_ruleDecls, ) where import BasicTypes import Control.Monad (unless) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Declaration.Value import Ormolu.Printer.Meat.Type p_ruleDecls :: RuleDecls GhcPs -> R () p_ruleDecls = \case HsRules NoExtField _ xs -> pragma "RULES" $ sep breakpoint (sitcc . located' p_ruleDecl) xs XRuleDecls x -> noExtCon x p_ruleDecl :: RuleDecl GhcPs -> R () p_ruleDecl = \case HsRule NoExtField ruleName activation tyvars ruleBndrs lhs rhs -> do located ruleName p_ruleName space p_activation activation space case tyvars of Nothing -> return () Just xs -> do p_forallBndrs ForallInvis p_hsTyVarBndr xs space -- It appears that there is no way to tell if there was an empty forall -- in the input or no forall at all. We do not want to add redundant -- foralls, so let's just skip the empty ones. unless (null ruleBndrs) $ p_forallBndrs ForallInvis p_ruleBndr ruleBndrs breakpoint inci $ do located lhs p_hsExpr space equals inci $ do breakpoint located rhs p_hsExpr XRuleDecl x -> noExtCon x p_ruleName :: (SourceText, RuleName) -> R () p_ruleName (_, name) = atom $ (HsString NoSourceText name :: HsLit GhcPs) p_ruleBndr :: RuleBndr GhcPs -> R () p_ruleBndr = \case RuleBndr NoExtField x -> p_rdrName x RuleBndrSig NoExtField x hswc -> parens N $ do p_rdrName x p_typeAscription hswc XRuleBndr x -> noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Signature.hs0000644000000000000000000001310107346545000022451 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Type signature declarations. module Ormolu.Printer.Meat.Declaration.Signature ( p_sigDecl, p_typeAscription, p_activation, p_standaloneKindSig, ) where import BasicTypes import BooleanFormula import Control.Monad import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type import Ormolu.Utils p_sigDecl :: Sig GhcPs -> R () p_sigDecl = \case TypeSig NoExtField names hswc -> p_typeSig True names hswc PatSynSig NoExtField names hsib -> p_patSynSig names hsib ClassOpSig NoExtField def names hsib -> p_classOpSig def names hsib FixSig NoExtField sig -> p_fixSig sig InlineSig NoExtField name inlinePragma -> p_inlineSig name inlinePragma SpecSig NoExtField name ts inlinePragma -> p_specSig name ts inlinePragma SpecInstSig NoExtField _ hsib -> p_specInstSig hsib MinimalSig NoExtField _ booleanFormula -> p_minimalSig booleanFormula CompleteMatchSig NoExtField _sourceText cs ty -> p_completeSig cs ty SCCFunSig NoExtField _ name literal -> p_sccSig name literal _ -> notImplemented "certain types of signature declarations" p_typeSig :: -- | Should the tail of the names be indented Bool -> -- | Names (before @::@) [Located RdrName] -> -- | Type LHsSigWcType GhcPs -> R () p_typeSig _ [] _ = return () -- should not happen though p_typeSig indentTail (n : ns) hswc = do p_rdrName n if null ns then p_typeAscription hswc else inciIf indentTail $ do commaDel sep commaDel p_rdrName ns p_typeAscription hswc p_typeAscription :: LHsSigWcType GhcPs -> R () p_typeAscription HsWC {..} = inci $ do space txt "::" let t = hsib_body hswc_body if hasDocStrings (unLoc t) then newline else breakpoint located t p_hsType p_typeAscription (XHsWildCardBndrs x) = noExtCon x p_patSynSig :: [Located RdrName] -> HsImplicitBndrs GhcPs (LHsType GhcPs) -> R () p_patSynSig names hsib = do txt "pattern" let body = p_typeSig False names HsWC {hswc_ext = NoExtField, hswc_body = hsib} if length names > 1 then breakpoint >> inci body else space >> body p_classOpSig :: -- | Whether this is a \"default\" signature Bool -> -- | Names (before @::@) [Located RdrName] -> -- | Type HsImplicitBndrs GhcPs (LHsType GhcPs) -> R () p_classOpSig def names hsib = do when def (txt "default" >> space) p_typeSig True names HsWC {hswc_ext = NoExtField, hswc_body = hsib} p_fixSig :: FixitySig GhcPs -> R () p_fixSig = \case FixitySig NoExtField names (Fixity _ n dir) -> do txt $ case dir of InfixL -> "infixl" InfixR -> "infixr" InfixN -> "infix" space atom n space sitcc $ sep commaDel p_rdrName names XFixitySig x -> noExtCon x p_inlineSig :: -- | Name Located RdrName -> -- | Inline pragma specification InlinePragma -> R () p_inlineSig name InlinePragma {..} = pragmaBraces $ do p_inlineSpec inl_inline space case inl_rule of ConLike -> txt "CONLIKE" FunLike -> return () space p_activation inl_act space p_rdrName name p_specSig :: -- | Name Located RdrName -> -- | The types to specialize to [LHsSigType GhcPs] -> -- | For specialize inline InlinePragma -> R () p_specSig name ts InlinePragma {..} = pragmaBraces $ do txt "SPECIALIZE" space p_inlineSpec inl_inline space p_activation inl_act space p_rdrName name space txt "::" breakpoint inci $ sep commaDel (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 commaDel (located' p_booleanFormula) xs Or xs -> sitcc $ sep (breakpoint >> txt "|" >> space) (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 sep commaDel p_rdrName cs forM_ mty $ \ty -> do space txt "::" breakpoint inci (p_rdrName ty) p_sccSig :: Located (IdP GhcPs) -> Maybe (Located StringLiteral) -> R () p_sccSig loc literal = pragma "SCC" . inci $ do p_rdrName loc forM_ literal $ \x -> do breakpoint atom x p_standaloneKindSig :: StandaloneKindSig GhcPs -> R () p_standaloneKindSig (StandaloneKindSig NoExtField name bndrs) = do txt "type" inci $ do space p_rdrName name space txt "::" breakpoint case bndrs of HsIB NoExtField sig -> located sig p_hsType XHsImplicitBndrs x -> noExtCon x p_standaloneKindSig (XStandaloneKindSig c) = noExtCon c ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Splice.hs0000644000000000000000000000056207346545000021736 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} module Ormolu.Printer.Meat.Declaration.Splice ( p_spliceDecl, ) where import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Declaration.Value (p_hsSplice) p_spliceDecl :: SpliceDecl GhcPs -> R () p_spliceDecl = \case SpliceDecl NoExtField splice _explicit -> located splice p_hsSplice XSpliceDecl x -> noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Type.hs0000644000000000000000000000162507346545000021441 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of type synonym declarations. module Ormolu.Printer.Meat.Declaration.Type ( p_synDecl, ) where import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type p_synDecl :: -- | Type constructor Located RdrName -> -- | Fixity LexicalFixity -> -- | Type variables LHsQTyVars GhcPs -> -- | RHS of type declaration LHsType GhcPs -> R () p_synDecl name fixity HsQTvs {..} t = do txt "type" space switchLayout (getLoc name : map getLoc hsq_explicit) $ p_infixDefHelper (case fixity of Infix -> True; _ -> False) True (p_rdrName name) (map (located' p_hsTyVarBndr) hsq_explicit) space equals if hasDocStrings (unLoc t) then newline else breakpoint inci (located t p_hsType) p_synDecl _ _ (XLHsQTyVars x) _ = noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs0000644000000000000000000000607407346545000022606 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of data\/type families. module Ormolu.Printer.Meat.Declaration.TypeFamily ( p_famDecl, p_tyFamInstEqn, ) where import Control.Monad import Data.Maybe (isNothing) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Type import Ormolu.Utils p_famDecl :: FamilyStyle -> FamilyDecl GhcPs -> R () p_famDecl style FamilyDecl {fdTyVars = HsQTvs {..}, ..} = do mmeqs <- case fdInfo of DataFamily -> Nothing <$ txt "data" OpenTypeFamily -> Nothing <$ txt "type" ClosedTypeFamily eqs -> Just eqs <$ txt "type" txt $ case style of Associated -> mempty Free -> " family" breakpoint inci $ do switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $ p_infixDefHelper (isInfix fdFixity) True (p_rdrName fdLName) (located' p_hsTyVarBndr <$> hsq_explicit) let resultSig = p_familyResultSigL fdResultSig unless (isNothing resultSig && isNothing fdInjectivityAnn) space inci $ do sequence_ resultSig space forM_ fdInjectivityAnn (located' p_injectivityAnn) case mmeqs of Nothing -> return () Just meqs -> do inci $ do breakpoint txt "where" case meqs of Nothing -> do space txt ".." Just eqs -> do newline sep newline (located' (inci . p_tyFamInstEqn)) eqs p_famDecl _ FamilyDecl {fdTyVars = XLHsQTyVars {}} = notImplemented "XLHsQTyVars" p_famDecl _ (XFamilyDecl x) = noExtCon x p_familyResultSigL :: Located (FamilyResultSig GhcPs) -> Maybe (R ()) p_familyResultSigL l = case l of L _ a -> case a of NoSig NoExtField -> Nothing KindSig NoExtField k -> Just $ do txt "::" breakpoint located k p_hsType TyVarSig NoExtField bndr -> Just $ do equals breakpoint located bndr p_hsTyVarBndr XFamilyResultSig x -> noExtCon x p_injectivityAnn :: InjectivityAnn GhcPs -> R () p_injectivityAnn (InjectivityAnn a bs) = do txt "|" space p_rdrName a space txt "->" space sep space p_rdrName bs p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R () p_tyFamInstEqn HsIB {hsib_body = FamEqn {..}} = do case feqn_bndrs of Nothing -> return () Just bndrs -> do p_forallBndrs ForallInvis p_hsTyVarBndr bndrs breakpoint inciIf (not $ null feqn_bndrs) $ do let famLhsSpn = getLoc feqn_tycon : fmap (getLoc . typeArgToType) feqn_pats switchLayout famLhsSpn $ p_infixDefHelper (isInfix feqn_fixity) True (p_rdrName feqn_tycon) (located' p_hsType . typeArgToType <$> feqn_pats) space equals breakpoint inci (located feqn_rhs p_hsType) p_tyFamInstEqn HsIB {hsib_body = XFamEqn x} = noExtCon x p_tyFamInstEqn (XHsImplicitBndrs x) = noExtCon x ---------------------------------------------------------------------------- -- Helpers isInfix :: LexicalFixity -> Bool isInfix = \case Infix -> True Prefix -> False ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Value.hs0000644000000000000000000012436707346545000021605 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeApplications #-} module Ormolu.Printer.Meat.Declaration.Value ( p_valDecl, p_pat, p_hsExpr, p_hsSplice, p_stringLit, ) where import Bag (bagToList) import BasicTypes import Control.Monad import Ctype (is_space) import Data.Bool (bool) import Data.Char (isPunctuation, isSymbol) import Data.Data hiding (Infix, Prefix) import Data.Functor ((<&>)) import Data.List (intersperse, sortOn) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import Data.Text (Text) import qualified Data.Text as Text import GHC import OccName (occNameString) import Ormolu.Printer.Combinators import Ormolu.Printer.Internal import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Signature import Ormolu.Printer.Meat.Type import Ormolu.Printer.Operators import Ormolu.Utils -- | Style of a group of equations. data MatchGroupStyle = Function (Located RdrName) | PatternBind | Case | Lambda | LambdaCase -- | Style of equations in a group. data GroupStyle = EqualSign | RightArrow -- | Expression placement. This marks the places where expressions that -- implement handing forms may use them. data Placement = -- | Multi-line layout should cause -- insertion of a newline and indentation -- bump Normal | -- | Expressions that have hanging form -- should use it and avoid bumping one level -- of indentation Hanging deriving (Eq, Show) p_valDecl :: HsBindLR GhcPs GhcPs -> R () p_valDecl = \case FunBind NoExtField funId funMatches _ _ -> p_funBind funId funMatches PatBind NoExtField pat grhss _ -> p_match PatternBind False NoSrcStrict [pat] grhss VarBind {} -> notImplemented "VarBinds" -- introduced by the type checker AbsBinds {} -> notImplemented "AbsBinds" -- introduced by the type checker PatSynBind NoExtField psb -> p_patSynBind psb XHsBindsLR x -> noExtCon x p_funBind :: Located RdrName -> MatchGroup GhcPs (LHsExpr GhcPs) -> R () p_funBind name = p_matchGroup (Function name) p_matchGroup :: MatchGroupStyle -> MatchGroup GhcPs (LHsExpr GhcPs) -> R () p_matchGroup = p_matchGroup' exprPlacement p_hsExpr p_matchGroup' :: Data body => -- | How to get body placement (body -> Placement) -> -- | How to print body (body -> R ()) -> -- | Style of this group of equations MatchGroupStyle -> -- | Match group MatchGroup GhcPs (Located body) -> R () p_matchGroup' placer render style MG {..} = do let ob = case style of Case -> id LambdaCase -> id _ -> dontUseBraces -- Since we are forcing braces on 'sepSemi' based on 'ob', we have to -- restore the brace state inside the sepsemi. ub <- bool dontUseBraces useBraces <$> canUseBraces ob $ sepSemi (located' (ub . p_Match)) (unLoc mg_alts) where p_Match m@Match {..} = p_match' placer render (adjustMatchGroupStyle m style) (isInfixMatch m) (matchStrictness m) m_pats m_grhss p_Match (XMatch x) = noExtCon x p_matchGroup' _ _ _ (XMatchGroup x) = noExtCon x -- | Function id obtained through pattern matching on 'FunBind' should not -- be used to print the actual equations because the different ‘RdrNames’ -- used in the equations may have different “decorations” (such as backticks -- and paretheses) associated with them. It is necessary to use per-equation -- names obtained from 'm_ctxt' of 'Match'. This function replaces function -- name inside of 'Function' accordingly. adjustMatchGroupStyle :: Match GhcPs body -> MatchGroupStyle -> MatchGroupStyle adjustMatchGroupStyle m = \case Function _ -> (Function . mc_fun . m_ctxt) m style -> style matchStrictness :: Match id body -> SrcStrictness matchStrictness match = case m_ctxt match of FunRhs {mc_strictness = s} -> s _ -> NoSrcStrict p_match :: -- | Style of the group MatchGroupStyle -> -- | Is this an infix match? Bool -> -- | Strictness prefix (FunBind) SrcStrictness -> -- | Argument patterns [LPat GhcPs] -> -- | Equations GRHSs GhcPs (LHsExpr GhcPs) -> R () p_match = p_match' exprPlacement p_hsExpr p_match' :: Data body => -- | How to get body placement (body -> Placement) -> -- | How to print body (body -> R ()) -> -- | Style of this group of equations MatchGroupStyle -> -- | Is this an infix match? Bool -> -- | Strictness prefix (FunBind) SrcStrictness -> -- | Argument patterns [LPat GhcPs] -> -- | Equations GRHSs GhcPs (Located body) -> R () p_match' placer render style isInfix strictness m_pats GRHSs {..} = do -- Normally, since patterns may be placed in a multi-line layout, it is -- necessary to bump indentation for the pattern group so it's more -- indented than function name. This in turn means that indentation for -- the body should also be bumped. Normally this would mean that bodies -- would start with two indentation steps applied, which is ugly, so we -- need to be a bit more clever here and bump indentation level only when -- pattern group is multiline. case strictness of NoSrcStrict -> return () SrcStrict -> txt "!" SrcLazy -> txt "~" indentBody <- case NE.nonEmpty m_pats of Nothing -> False <$ case style of Function name -> p_rdrName name _ -> return () Just ne_pats -> do let combinedSpans = case style of Function name -> combineSrcSpans (getLoc name) patSpans _ -> patSpans patSpans = combineSrcSpans' (getLoc <$> ne_pats) indentBody = not (isOneLineSpan combinedSpans) switchLayout [combinedSpans] $ do let stdCase = sep breakpoint (located' p_pat) m_pats case style of Function name -> p_infixDefHelper isInfix indentBody (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 indentBody let -- Calculate position of end of patterns. This is useful when we decide -- about putting certain constructions in hanging positions. endOfPats = case NE.nonEmpty m_pats of Nothing -> case style of Function name -> Just (getLoc name) _ -> Nothing Just pats -> (Just . getLoc . NE.last) pats isCase = \case Case -> True LambdaCase -> True _ -> False hasGuards = withGuards grhssGRHSs grhssSpan = combineSrcSpans' $ getGRHSSpan . unLoc <$> NE.fromList grhssGRHSs patGrhssSpan = maybe grhssSpan (combineSrcSpans grhssSpan . srcLocSpan . srcSpanEnd) endOfPats placement = case endOfPats of Nothing -> blockPlacement placer grhssGRHSs Just spn -> if onTheSameLine spn grhssSpan then blockPlacement placer grhssGRHSs else Normal p_body = do let groupStyle = if isCase style && hasGuards then RightArrow else EqualSign sep newline (located' (p_grhs' placer render groupStyle)) grhssGRHSs p_where = do let whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds) unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds)) $ do breakpoint txt "where" unless whereIsEmpty breakpoint inci $ located grhssLocalBinds p_hsLocalBinds inciIf indentBody $ do unless (length grhssGRHSs > 1) $ case style of Function _ | hasGuards -> return () Function _ -> space >> inci equals PatternBind -> space >> inci equals s | isCase s && hasGuards -> return () _ -> space >> txt "->" switchLayout [patGrhssSpan] $ placeHanging placement p_body inci p_where p_match' _ _ _ _ _ _ (XGRHSs x) = noExtCon x p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R () p_grhs = p_grhs' exprPlacement p_hsExpr p_grhs' :: Data body => -- | How to get body placement (body -> Placement) -> -- | How to print body (body -> R ()) -> GroupStyle -> GRHS GhcPs (Located body) -> R () p_grhs' placer render style (GRHS NoExtField guards body) = case guards of [] -> p_body xs -> do txt "|" space sitcc (sep commaDel (sitcc . located' p_stmt) xs) space inci $ case style of EqualSign -> equals RightArrow -> txt "->" placeHanging placement p_body where placement = case endOfGuards of Nothing -> placer (unLoc body) Just spn -> if onTheSameLine spn (getLoc body) then placer (unLoc body) else Normal endOfGuards = case NE.nonEmpty guards of Nothing -> Nothing Just gs -> (Just . getLoc . NE.last) gs p_body = located body render p_grhs' _ _ _ (XGRHS x) = noExtCon x p_hsCmd :: HsCmd GhcPs -> R () p_hsCmd = \case HsCmdArrApp NoExtField body input arrType _ -> do located body p_hsExpr breakpoint inci $ do case arrType of HsFirstOrderApp -> txt "-<" HsHigherOrderApp -> txt "-<<" placeHanging (exprPlacement (unLoc input)) $ located input p_hsExpr HsCmdArrForm NoExtField form Prefix _ cmds -> banana $ do located form p_hsExpr unless (null cmds) $ do breakpoint inci (sequence_ (intersperse breakpoint (located' p_hsCmdTop <$> cmds))) HsCmdArrForm NoExtField form Infix _ [left, right] -> do located left p_hsCmdTop space located form p_hsExpr placeHanging (cmdTopPlacement (unLoc right)) $ located right p_hsCmdTop HsCmdArrForm NoExtField _ Infix _ _ -> notImplemented "HsCmdArrForm" HsCmdApp {} -> -- XXX Does this ever occur in the syntax tree? It does not seem like it -- does. Open an issue and ping @yumiova if this ever occurs in output. notImplemented "HsCmdApp" HsCmdLam NoExtField mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup HsCmdPar NoExtField c -> parens N (located c p_hsCmd) HsCmdCase NoExtField e mgroup -> p_case cmdPlacement p_hsCmd e mgroup HsCmdIf NoExtField _ if' then' else' -> p_if cmdPlacement p_hsCmd if' then' else' HsCmdLet NoExtField localBinds c -> p_let p_hsCmd localBinds c HsCmdDo NoExtField es -> do txt "do" newline inci . located es $ sitcc . sep newline (sitcc . withSpacing (p_stmt' cmdPlacement p_hsCmd)) HsCmdWrap {} -> notImplemented "HsCmdWrap" XCmd x -> noExtCon x p_hsCmdTop :: HsCmdTop GhcPs -> R () p_hsCmdTop = \case HsCmdTop NoExtField cmd -> located cmd p_hsCmd XCmdTop x -> noExtCon x -- | Render an expression preserving blank lines between such consecutive -- expressions found in the original source code. withSpacing :: -- | Rendering function (a -> R ()) -> -- | Entity to render Located a -> R () withSpacing f l = located l $ \x -> do case getLoc l of UnhelpfulSpan _ -> f x RealSrcSpan currentSpn -> do getSpanMark >>= \case -- Spacing before comments will be handled by the code -- that prints comments, so we just have to deal with -- blank lines between statements here. Just (StatementSpan lastSpn) -> if srcSpanStartLine currentSpn > srcSpanEndLine lastSpn + 1 then newline else return () _ -> return () f x -- In some cases the (f x) expression may insert a new mark. We want -- to be careful not to override comment marks. getSpanMark >>= \case Just (HaddockSpan _ _) -> return () Just (CommentSpan _) -> return () _ -> setSpanMark (StatementSpan currentSpn) p_stmt :: Stmt GhcPs (LHsExpr GhcPs) -> R () p_stmt = p_stmt' exprPlacement p_hsExpr p_stmt' :: Data body => -- | Placer (body -> Placement) -> -- | Render (body -> R ()) -> -- | Statement to render Stmt GhcPs (Located body) -> R () p_stmt' placer render = \case LastStmt NoExtField body _ _ -> located body render BindStmt NoExtField p f _ _ -> do located p p_pat space txt "<-" let loc = getLoc p placement = case f of L l' x -> if isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l')) then placer x else Normal switchLayout [loc, getLoc f] $ placeHanging placement (located f render) ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer BodyStmt NoExtField body _ _ -> located body render LetStmt NoExtField binds -> do txt "let" space sitcc $ located binds p_hsLocalBinds ParStmt {} -> -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such -- that it never occurs in 'p_stmt''. Consequently, handling it here -- would be redundant. notImplemented "ParStmt" TransStmt {..} -> -- 'TransStmt' only needs to account for render printing itself, since -- pretty printing of relevant statements (e.g., in 'trS_stmts') is -- handled through 'gatherStmt'. case (trS_form, trS_by) of (ThenForm, Nothing) -> do txt "then" breakpoint inci $ located trS_using p_hsExpr (ThenForm, Just e) -> do txt "then" breakpoint inci $ located trS_using p_hsExpr breakpoint txt "by" breakpoint inci $ located e p_hsExpr (GroupForm, Nothing) -> do txt "then group using" breakpoint inci $ located trS_using p_hsExpr (GroupForm, Just e) -> do txt "then group by" breakpoint inci $ located e p_hsExpr breakpoint txt "using" breakpoint inci $ located trS_using p_hsExpr RecStmt {..} -> do txt "rec" space sitcc $ sepSemi (withSpacing (p_stmt' placer render)) recS_stmts XStmtLR c -> noExtCon c gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]] gatherStmt (L _ (ParStmt NoExtField block _ _)) = foldr ((<>) . gatherStmtBlock) [] block gatherStmt (L s stmt@TransStmt {..}) = foldr liftAppend [] ((gatherStmt <$> trS_stmts) <> pure [[L s stmt]]) gatherStmt stmt = [[stmt]] gatherStmtBlock :: ParStmtBlock GhcPs GhcPs -> [[ExprLStmt GhcPs]] gatherStmtBlock (ParStmtBlock _ stmts _ _) = foldr (liftAppend . gatherStmt) [] stmts gatherStmtBlock (XParStmtBlock x) = noExtCon x p_hsLocalBinds :: HsLocalBindsLR GhcPs GhcPs -> R () p_hsLocalBinds = \case HsValBinds NoExtField (ValBinds NoExtField bag lsigs) -> do -- 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 let items = let injectLeft (L l x) = L l (Left x) injectRight (L l x) = L l (Right x) in (injectLeft <$> bagToList bag) ++ (injectRight <$> lsigs) positionToBracing = \case SinglePos -> id FirstPos -> br MiddlePos -> br LastPos -> id p_item' (p, item) = positionToBracing p $ withSpacing (either p_valDecl p_sigDecl) item binds = sortOn (srcSpanStart . getLoc) items sitcc $ sepSemi p_item' (attachRelativePos binds) HsValBinds NoExtField _ -> notImplemented "HsValBinds" HsIPBinds NoExtField (IPBinds NoExtField xs) -> -- Second argument of IPBind is always Left before type-checking. let p_ipBind (IPBind NoExtField (Left name) expr) = do atom name space equals breakpoint useBraces $ inci $ located expr p_hsExpr p_ipBind (IPBind NoExtField (Right _) _) = -- Should only occur after the type checker notImplemented "IPBind _ (Right _) _" p_ipBind (XIPBind x) = noExtCon x in sepSemi (located' p_ipBind) xs HsIPBinds NoExtField _ -> notImplemented "HsIpBinds" EmptyLocalBinds NoExtField -> return () XHsLocalBindsLR x -> noExtCon x p_hsRecField :: HsRecField' RdrName (LHsExpr GhcPs) -> R () p_hsRecField HsRecField {..} = do p_rdrName hsRecFieldLbl unless hsRecPun $ do space equals let placement = if onTheSameLine (getLoc hsRecFieldLbl) (getLoc hsRecFieldArg) then exprPlacement (unLoc hsRecFieldArg) else Normal placeHanging placement (located hsRecFieldArg p_hsExpr) p_hsExpr :: HsExpr GhcPs -> R () p_hsExpr = p_hsExpr' N p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R () p_hsExpr' s = \case HsVar NoExtField name -> p_rdrName name HsUnboundVar NoExtField v -> atom (unboundVarOcc v) HsConLikeOut NoExtField _ -> notImplemented "HsConLikeOut" HsRecFld NoExtField x -> case x of Unambiguous NoExtField name -> p_rdrName name Ambiguous NoExtField name -> p_rdrName name XAmbiguousFieldOcc xx -> noExtCon xx HsOverLabel NoExtField _ v -> do txt "#" atom v HsIPVar NoExtField (HsIPName name) -> do txt "?" atom name HsOverLit NoExtField v -> atom (ol_val v) HsLit NoExtField lit -> case lit of HsString (SourceText stxt) _ -> p_stringLit stxt HsStringPrim (SourceText stxt) _ -> p_stringLit stxt r -> atom r HsLam NoExtField mgroup -> p_matchGroup Lambda mgroup HsLamCase NoExtField mgroup -> do txt "\\case" breakpoint inci (p_matchGroup LambdaCase mgroup) HsApp NoExtField f x -> do let -- In order to format function applications with multiple parameters -- nicer, traverse the AST to gather the function and all the -- parameters together. gatherArgs f' knownArgs = case f' of L _ (HsApp _ l r) -> gatherArgs l (r <| knownArgs) _ -> (f', knownArgs) (func, args) = gatherArgs f (x :| []) -- We need to handle the last argument specially if it is a -- hanging construct, so separate it from the rest. (initp, lastp) = (NE.init args, NE.last args) initSpan = combineSrcSpans' $ getLoc f :| [(srcLocSpan . srcSpanStart . getLoc) lastp] -- Hang the last argument only if the initial arguments span one -- line. placement = if isOneLineSpan initSpan then exprPlacement (unLoc lastp) else Normal -- If the last argument is not hanging, just separate every argument as -- usual. If it is hanging, print the initial arguments and hang the -- last one. Also, use braces around the every argument except the last -- one. case placement of Normal -> do let -- Usually we want to bump indentation for arguments for the -- sake of readability. However, when the function itself is a -- do-block or case expression it is not a good idea. It seems -- to be safe to always bump indentation when the function -- expression is parenthesised. doIndent = case func of L _ (HsPar NoExtField _) -> True L _ (HsAppType NoExtField _ _) -> True L _ (HsMultiIf NoExtField _) -> True L spn _ -> isOneLineSpan spn ub <- getLayout <&> \case SingleLine -> useBraces MultiLine -> id ub $ do located func (p_hsExpr' s) breakpoint inciIf doIndent $ sep breakpoint (located' p_hsExpr) initp inciIf doIndent $ do unless (null initp) breakpoint located lastp p_hsExpr Hanging -> do useBraces . switchLayout [initSpan] $ do located func (p_hsExpr' s) breakpoint sep breakpoint (located' p_hsExpr) initp placeHanging placement $ located lastp p_hsExpr HsAppType NoExtField e a -> do located e p_hsExpr breakpoint inci $ do txt "@" -- Insert a space when the type is represented as a TH splice to avoid -- gluing @ and $ together. case unLoc (hswc_body a) of HsSpliceTy {} -> space _ -> return () located (hswc_body a) p_hsType OpApp NoExtField x op y -> do let opTree = OpBranch (exprOpTree x) op (exprOpTree y) p_exprOpTree s (reassociateOpTree getOpName opTree) NegApp NoExtField e _ -> do txt "-" space located e p_hsExpr HsPar NoExtField e -> parens s (located e (dontUseBraces . p_hsExpr)) SectionL NoExtField x op -> do located x p_hsExpr breakpoint inci (located op p_hsExpr) SectionR NoExtField op x -> do located op p_hsExpr useRecordDot' <- useRecordDot let isRecordDot' = isRecordDot (unLoc op) (getLoc x) unless (useRecordDot' && isRecordDot') breakpoint inci (located x p_hsExpr) ExplicitTuple NoExtField args boxity -> let isSection = any (isMissing . unLoc) args isMissing = \case Missing NoExtField -> True _ -> False p_arg = \case Present NoExtField x -> located x p_hsExpr Missing NoExtField -> pure () XTupArg x -> noExtCon x p_larg = sitcc . located' p_arg parens' = case boxity of Boxed -> parens Unboxed -> parensHash in if isSection then switchLayout [] . parens' s $ sep comma p_larg args else switchLayout (getLoc <$> args) . parens' s $ sep commaDel p_larg args ExplicitSum NoExtField tag arity e -> p_unboxedSum N tag arity (located e p_hsExpr) HsCase NoExtField e mgroup -> p_case exprPlacement p_hsExpr e mgroup HsIf NoExtField _ if' then' else' -> p_if exprPlacement p_hsExpr if' then' else' HsMultiIf NoExtField guards -> do txt "if" breakpoint inci . inci $ sep newline (located' (p_grhs RightArrow)) guards HsLet NoExtField localBinds e -> p_let p_hsExpr localBinds e HsDo NoExtField ctx es -> do let doBody header = do txt header breakpoint ub <- layoutToBraces <$> getLayout inci $ sepSemi (ub . withSpacing (p_stmt' exprPlacement (p_hsExpr' S))) (unLoc es) compBody = brackets N . located es $ \xs -> do let p_parBody = sep (breakpoint >> txt "|" >> space) p_seqBody p_seqBody = sitcc . sep commaDel (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 $ sep commaDel (sitcc . located' p_hsExpr) xs RecordCon {..} -> do located rcon_con_name atom breakpoint let HsRecFields {..} = rcon_flds updName f = (f :: HsRecField GhcPs (LHsExpr GhcPs)) { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of FieldOcc _ n -> n XFieldOcc x -> noExtCon x } fields = located' (p_hsRecField . updName) <$> rec_flds dotdot = case rec_dotdot of Just {} -> [txt ".."] Nothing -> [] inci . braces N $ sep commaDel sitcc (fields <> dotdot) RecordUpd {..} -> do located rupd_expr p_hsExpr useRecordDot' <- useRecordDot let mrs sp = case getLoc sp of RealSrcSpan r -> Just r _ -> Nothing let isPluginForm = ((1 +) . srcSpanEndCol <$> mrs rupd_expr) == (srcSpanStartCol <$> mrs (head rupd_flds)) unless (useRecordDot' && isPluginForm) breakpoint let updName f = (f :: HsRecUpdField GhcPs) { hsRecFieldLbl = case unLoc $ hsRecFieldLbl f of Ambiguous _ n -> n Unambiguous _ n -> n XAmbiguousFieldOcc x -> noExtCon x } inci . braces N $ sep commaDel (sitcc . located' (p_hsRecField . updName)) rupd_flds ExprWithTySig NoExtField x HsWC {hswc_body = HsIB {..}} -> sitcc $ do located x p_hsExpr space txt "::" breakpoint inci $ located hsib_body p_hsType ExprWithTySig NoExtField _ HsWC {hswc_body = XHsImplicitBndrs x} -> noExtCon x ExprWithTySig NoExtField _ (XHsWildCardBndrs x) -> noExtCon x ArithSeq NoExtField _ x -> case x of From from -> brackets s $ do located from p_hsExpr breakpoint txt ".." FromThen from next -> brackets s $ do sep commaDel (located' p_hsExpr) [from, next] breakpoint txt ".." FromTo from to -> brackets s $ do located from p_hsExpr breakpoint txt ".." space located to p_hsExpr FromThenTo from next to -> brackets s $ do sep commaDel (located' p_hsExpr) [from, next] breakpoint txt ".." space located to p_hsExpr HsSCC NoExtField _ name x -> do txt "{-# SCC " atom name txt " #-}" breakpoint located x p_hsExpr HsCoreAnn NoExtField _ value x -> do txt "{-# CORE " atom value txt " #-}" breakpoint located x p_hsExpr HsBracket NoExtField x -> p_hsBracket x HsRnBracketOut {} -> notImplemented "HsRnBracketOut" HsTcBracketOut {} -> notImplemented "HsTcBracketOut" HsSpliceE NoExtField splice -> p_hsSplice splice HsProc NoExtField p e -> do txt "proc" located p $ \x -> do breakpoint inci (p_pat x) breakpoint txt "->" placeHanging (cmdTopPlacement (unLoc e)) $ located e p_hsCmdTop HsStatic _ e -> do txt "static" breakpoint inci (located e p_hsExpr) HsTick {} -> notImplemented "HsTick" HsBinTick {} -> notImplemented "HsBinTick" HsTickPragma {} -> notImplemented "HsTickPragma" HsWrap {} -> notImplemented "HsWrap" XExpr x -> noExtCon x p_patSynBind :: PatSynBind GhcPs GhcPs -> R () p_patSynBind PSB {..} = do let rhs = do space case psb_dir of Unidirectional -> do txt "<-" breakpoint located psb_def p_pat ImplicitBidirectional -> do equals breakpoint located psb_def p_pat ExplicitBidirectional mgroup -> do txt "<-" breakpoint located psb_def p_pat newline txt "where" newline inci (p_matchGroup (Function psb_id) mgroup) txt "pattern" case psb_args of PrefixCon xs -> do space p_rdrName psb_id inci $ do switchLayout (getLoc <$> xs) $ do unless (null xs) breakpoint sitcc (sep breakpoint p_rdrName xs) rhs RecCon xs -> do space p_rdrName psb_id inci $ do switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do unless (null xs) breakpoint braces N $ sep commaDel (p_rdrName . recordPatSynPatVar) xs rhs InfixCon l r -> do switchLayout [getLoc l, getLoc r] $ do space p_rdrName l breakpoint inci $ do p_rdrName psb_id space p_rdrName r inci rhs p_patSynBind (XPatSynBind x) = noExtCon x p_case :: Data body => -- | Placer (body -> Placement) -> -- | Render (body -> R ()) -> -- | Expression LHsExpr GhcPs -> -- | Match group MatchGroup GhcPs (Located body) -> R () p_case placer render e mgroup = do txt "case" space located e p_hsExpr space txt "of" breakpoint inci (p_matchGroup' placer render Case mgroup) p_if :: Data body => -- | Placer (body -> Placement) -> -- | Render (body -> R ()) -> -- | If LHsExpr GhcPs -> -- | Then Located body -> -- | Else Located body -> R () p_if placer render if' then' else' = do txt "if" space located if' p_hsExpr breakpoint inci $ do txt "then" space located then' $ \x -> placeHanging (placer x) (render x) breakpoint txt "else" space located else' $ \x -> placeHanging (placer x) (render x) p_let :: Data body => -- | Render (body -> R ()) -> Located (HsLocalBindsLR GhcPs GhcPs) -> Located body -> R () p_let render localBinds e = sitcc $ do txt "let" space dontUseBraces $ sitcc (located localBinds p_hsLocalBinds) vlayout space (newline >> txt " ") txt "in" space sitcc (located e render) p_pat :: Pat GhcPs -> R () p_pat = \case WildPat NoExtField -> txt "_" VarPat NoExtField name -> p_rdrName name LazyPat NoExtField pat -> do txt "~" located pat p_pat AsPat NoExtField name pat -> do p_rdrName name txt "@" located pat p_pat ParPat NoExtField pat -> located pat (parens S . p_pat) BangPat NoExtField pat -> do txt "!" located pat p_pat ListPat NoExtField pats -> brackets S $ sep commaDel (located' p_pat) pats TuplePat NoExtField pats boxing -> do let parens' = case boxing of Boxed -> parens S Unboxed -> parensHash S parens' $ sep commaDel (sitcc . located' p_pat) pats SumPat NoExtField pat tag arity -> p_unboxedSum S tag arity (located pat p_pat) ConPatIn pat details -> 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 . sep commaDel f $ case dotdot of Nothing -> Just <$> fields Just (L _ n) -> (Just <$> take n fields) ++ [Nothing] InfixCon l r -> do switchLayout [getLoc l, getLoc r] $ do located l p_pat breakpoint inci $ do p_rdrName pat space located r p_pat ConPatOut {} -> notImplemented "ConPatOut" -- presumably created by renamer? ViewPat NoExtField expr pat -> sitcc $ do located expr p_hsExpr space txt "->" breakpoint inci (located pat p_pat) SplicePat NoExtField splice -> p_hsSplice splice LitPat NoExtField p -> atom p NPat NoExtField v _ _ -> located v (atom . ol_val) NPlusKPat NoExtField n k _ _ _ -> sitcc $ do p_rdrName n breakpoint inci $ do txt "+" space located k (atom . ol_val) SigPat NoExtField pat hswc -> do located pat p_pat p_typeAscription hswc CoPat {} -> notImplemented "CoPat" -- apparently created at some later stage XPat x -> noExtCon x p_pat_hsRecField :: HsRecField' (FieldOcc GhcPs) (LPat GhcPs) -> R () p_pat_hsRecField HsRecField {..} = do located hsRecFieldLbl $ \x -> p_rdrName (rdrNameFieldOcc x) unless hsRecPun $ do space equals breakpoint inci (located hsRecFieldArg p_pat) p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R () p_unboxedSum s tag arity m = do let before = tag - 1 after = arity - before - 1 args = replicate before Nothing <> [Just m] <> replicate after Nothing f x = case x :: Maybe (R ()) of Nothing -> space Just m' -> do space m' space parensHash s $ sep (txt "|") f args p_hsSplice :: HsSplice GhcPs -> R () p_hsSplice = \case HsTypedSplice NoExtField deco _ expr -> p_hsSpliceTH True expr deco HsUntypedSplice NoExtField deco _ expr -> p_hsSpliceTH False expr deco HsQuasiQuote NoExtField _ quoterName srcSpan str -> do txt "[" p_rdrName (L srcSpan quoterName) txt "|" -- QuasiQuoters often rely on precise custom strings. We cannot do any -- formatting here without potentially breaking someone's code. atom str txt "|]" HsSpliced {} -> notImplemented "HsSpliced" HsSplicedT {} -> notImplemented "HsSplicedT" XSplice x -> noExtCon x p_hsSpliceTH :: -- | Typed splice? Bool -> -- | Splice expression LHsExpr GhcPs -> -- | Splice decoration SpliceDecoration -> R () p_hsSpliceTH isTyped expr = \case HasParens -> do txt decoSymbol parens N (located expr (sitcc . p_hsExpr)) HasDollar -> do txt decoSymbol located expr (sitcc . p_hsExpr) NoParens -> located expr (sitcc . p_hsExpr) where decoSymbol = if isTyped then "$$" else "$" p_hsBracket :: HsBracket GhcPs -> R () p_hsBracket = \case ExpBr NoExtField expr -> do anns <- getEnclosingAnns let name = case anns of AnnOpenEQ : _ -> "" _ -> "e" quote name (located expr p_hsExpr) PatBr NoExtField pat -> located pat (quote "p" . p_pat) DecBrL NoExtField decls -> quote "d" (p_hsDecls Free decls) DecBrG NoExtField _ -> notImplemented "DecBrG" -- result of renamer TypBr NoExtField ty -> quote "t" (located ty p_hsType) VarBr NoExtField isSingleQuote name -> do txt (bool "''" "'" isSingleQuote) -- HACK As you can see we use 'noLoc' here to be able to pass name into -- 'p_rdrName' since the latter expects a "located" thing. The problem -- is that 'VarBr' doesn't provide us with location of the name. This in -- turn makes it impossible to detect if there are parentheses around -- it, etc. So we have to add parentheses manually assuming they are -- necessary for all operators. let isOperator = all (\i -> isPunctuation i || isSymbol i) (showOutputable (rdrNameOcc name)) && not (doesNotNeedExtraParens name) wrapper = if isOperator then parens N else id wrapper $ p_rdrName (noLoc name) TExpBr NoExtField expr -> do txt "[||" breakpoint' located expr p_hsExpr breakpoint' txt "||]" XBracket x -> noExtCon x where quote :: Text -> R () -> R () quote name body = do txt "[" txt name txt "|" breakpoint' inci $ do dontUseBraces body breakpoint' txt "|]" -- Print the source text of a string literal while indenting -- gaps correctly. p_stringLit :: String -> R () p_stringLit src = let s = splitGaps src singleLine = txt $ Text.pack (mconcat s) multiLine = sitcc $ sep breakpoint (txt . Text.pack) (backslashes s) in vlayout singleLine multiLine where -- Split a string on gaps (backslash delimited whitespaces) -- -- > splitGaps "bar\\ \\fo\\&o" == ["bar", "fo\\&o"] splitGaps :: String -> [String] splitGaps "" = [] splitGaps s = let -- A backslash and a whitespace starts a "gap" p (Just '\\', _, _) = True p (_, '\\', Just c) | ghcSpace c = False p _ = True in case span p (zipPrevNext s) of (l, r) -> let -- drop the initial '\', any amount of 'ghcSpace', and another '\' r' = drop 1 . dropWhile ghcSpace . drop 1 $ map orig r in map orig l : splitGaps r' -- GHC's definition of whitespaces in strings -- See: https://gitlab.haskell.org/ghc/ghc/blob/86753475/compiler/parser/Lexer.x#L1653 ghcSpace :: Char -> Bool ghcSpace c = c <= '\x7f' && is_space c -- Add backslashes to the inner side of the strings -- -- > backslashes ["a", "b", "c"] == ["a\\", "\\b\\", "\\c"] backslashes :: [String] -> [String] backslashes (x : y : xs) = (x ++ "\\") : backslashes (('\\' : y) : xs) backslashes xs = xs -- Attaches previous and next items to each list element zipPrevNext :: [a] -> [(Maybe a, a, Maybe a)] zipPrevNext xs = let z = zip (zip (Nothing : map Just xs) xs) (map Just (tail xs) ++ repeat Nothing) in map (\((p, x), n) -> (p, x, n)) z orig (_, x, _) = x ---------------------------------------------------------------------------- -- Helpers -- | Return the wrapping function controlling the use of braces according to -- the current layout. layoutToBraces :: Layout -> R () -> R () layoutToBraces = \case SingleLine -> useBraces MultiLine -> id -- | Append each element in both lists with semigroups. If one list is shorter -- than the other, return the rest of the longer list unchanged. liftAppend :: Semigroup a => [a] -> [a] -> [a] liftAppend [] [] = [] liftAppend [] (y : ys) = y : ys liftAppend (x : xs) [] = x : xs liftAppend (x : xs) (y : ys) = x <> y : liftAppend xs ys getGRHSSpan :: GRHS GhcPs (Located body) -> SrcSpan getGRHSSpan (GRHS NoExtField guards body) = combineSrcSpans' $ getLoc body :| map getLoc guards getGRHSSpan (XGRHS x) = noExtCon x -- | Place a thing that may have a hanging form. This function handles how -- to separate it from preceding expressions and whether to bump indentation -- depending on what sort of expression we have. placeHanging :: Placement -> R () -> R () placeHanging placement m = case placement of Hanging -> do space m Normal -> do breakpoint inci m -- | Check if given block contains single expression which has a hanging -- form. blockPlacement :: (body -> Placement) -> [LGRHS GhcPs (Located body)] -> Placement blockPlacement placer [L _ (GRHS NoExtField _ (L _ x))] = placer x blockPlacement _ _ = Normal -- | Check if given command has a hanging form. cmdPlacement :: HsCmd GhcPs -> Placement cmdPlacement = \case HsCmdLam NoExtField _ -> Hanging HsCmdCase NoExtField _ _ -> Hanging HsCmdDo NoExtField _ -> Hanging _ -> Normal cmdTopPlacement :: HsCmdTop GhcPs -> Placement cmdTopPlacement = \case HsCmdTop NoExtField (L _ x) -> cmdPlacement x XCmdTop x -> noExtCon x -- | Check if given expression has a hanging form. exprPlacement :: HsExpr GhcPs -> Placement exprPlacement = \case -- Only hang lambdas with single line parameter lists HsLam NoExtField mg -> case mg of MG _ (L _ [L _ (Match NoExtField _ (x : xs) _)]) _ | isOneLineSpan (combineSrcSpans' $ fmap getLoc (x :| xs)) -> Hanging _ -> Normal HsLamCase NoExtField _ -> Hanging HsCase NoExtField _ _ -> Hanging HsDo NoExtField DoExpr _ -> Hanging HsDo NoExtField MDoExpr _ -> Hanging OpApp NoExtField _ op y -> case (fmap getOpNameStr . getOpName . unLoc) op of Just "$" -> exprPlacement (unLoc y) _ -> Normal HsApp NoExtField _ y -> exprPlacement (unLoc y) HsProc NoExtField p _ -> -- Indentation breaks if pattern is longer than one line and left -- hanging. Consequently, only apply hanging when it is safe. if isOneLineSpan (getLoc p) then Hanging else Normal _ -> Normal withGuards :: [LGRHS GhcPs (Located body)] -> Bool withGuards = any (checkOne . unLoc) where checkOne :: GRHS GhcPs (Located body) -> Bool checkOne (GRHS NoExtField [] _) = False checkOne _ = True exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) exprOpTree (L _ (OpApp NoExtField x op y)) = OpBranch (exprOpTree x) op (exprOpTree y) exprOpTree n = OpNode n getOpName :: HsExpr GhcPs -> Maybe RdrName getOpName = \case HsVar NoExtField (L _ a) -> Just a _ -> Nothing getOpNameStr :: RdrName -> String getOpNameStr = occNameString . rdrNameOcc p_exprOpTree :: -- | Bracket style to use BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R () p_exprOpTree s (OpNode x) = located x (p_hsExpr' s) p_exprOpTree s (OpBranch x op y) = do -- If the beginning of the first argument and the second argument are on -- the same line, and the second argument has a hanging form, use hanging -- placement. let placement = if isOneLineSpan (mkSrcSpan (srcSpanStart (opTreeLoc x)) (srcSpanStart (opTreeLoc y))) then case y of OpNode (L _ n) -> exprPlacement n _ -> Normal else Normal -- Distinguish holes used in infix notation. -- eg. '1 _foo 2' and '1 `_foo` 2' opWrapper = case unLoc op of HsUnboundVar NoExtField _ -> backticks _ -> id layout <- getLayout let ub = case layout of SingleLine -> useBraces MultiLine -> case placement of Hanging -> useBraces Normal -> dontUseBraces opNameStr = (fmap getOpNameStr . getOpName . unLoc) op gotDollar = opNameStr == Just "$" gotColon = opNameStr == Just ":" gotRecordDot = isRecordDot (unLoc op) (opTreeLoc y) lhs = switchLayout [opTreeLoc x] $ p_exprOpTree s x p_op = located op (opWrapper . p_hsExpr) p_y = switchLayout [opTreeLoc y] (p_exprOpTree N y) isSection = case (opTreeLoc x, getLoc op) of (RealSrcSpan treeSpan, RealSrcSpan opSpan) -> srcSpanEndCol treeSpan /= srcSpanStartCol opSpan _ -> False isDoBlock = \case OpNode (L _ HsDo {}) -> True _ -> False useRecordDot' <- useRecordDot if | gotColon -> do lhs space p_op case placement of Hanging -> do space p_y Normal -> do breakpoint inciIf (isDoBlock y) p_y | gotDollar && isOneLineSpan (opTreeLoc x) && placement == Normal -> do useBraces lhs space p_op breakpoint inci p_y | useRecordDot' && gotRecordDot -> do lhs when isSection space p_op p_y | otherwise -> do ub lhs placeHanging placement $ do p_op space p_y -- | Return 'True' if given expression is a record-dot operator expression. isRecordDot :: -- | Operator expression HsExpr GhcPs -> -- | Span of the expression on the right-hand side of the operator SrcSpan -> Bool isRecordDot op (RealSrcSpan ySpan) = case op of HsVar NoExtField (L (RealSrcSpan opSpan) opName) -> (getOpNameStr opName == ".") && (srcSpanEndCol opSpan == srcSpanStartCol ySpan) _ -> False isRecordDot _ _ = False -- | 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') ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Value.hs-boot0000644000000000000000000000053007346545000022527 0ustar0000000000000000module 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 () ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Declaration/Warning.hs0000644000000000000000000000255707346545000022132 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} module Ormolu.Printer.Meat.Declaration.Warning ( p_warnDecls, p_moduleWarning, ) where import BasicTypes import Data.Foldable import Data.Text (Text) import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common p_warnDecls :: WarnDecls GhcPs -> R () p_warnDecls (Warnings NoExtField _ warnings) = traverse_ (located' p_warnDecl) warnings p_warnDecls (XWarnDecls x) = noExtCon x p_warnDecl :: WarnDecl GhcPs -> R () p_warnDecl (Warning NoExtField functions warningTxt) = p_topLevelWarning functions warningTxt p_warnDecl (XWarnDecl x) = noExtCon x p_moduleWarning :: WarningTxt -> R () p_moduleWarning wtxt = do let (pragmaText, lits) = warningText wtxt inci $ pragma pragmaText $ inci $ p_lits lits p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R () p_topLevelWarning fnames wtxt = do let (pragmaText, lits) = warningText wtxt switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ pragma pragmaText . inci $ do sep commaDel 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 $ sep commaDel atom ls ormolu-0.1.2.0/src/Ormolu/Printer/Meat/ImportExport.hs0000644000000000000000000000622507346545000020750 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of import and export lists. module Ormolu.Printer.Meat.ImportExport ( p_hsmodExports, p_hsmodImport, ) where import Control.Monad import GHC import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import Ormolu.Utils (RelativePos (..), attachRelativePos) p_hsmodExports :: [LIE GhcPs] -> R () p_hsmodExports [] = do txt "(" breakpoint' txt ")" p_hsmodExports xs = parens N $ do layout <- getLayout sep breakpoint (\(p, l) -> sitcc (located l (p_lie layout p))) (attachRelativePos xs) p_hsmodImport :: Bool -> ImportDecl GhcPs -> R () p_hsmodImport useQualifiedPost ImportDecl {..} = do txt "import" space when ideclSource (txt "{-# SOURCE #-}") space when ideclSafe (txt "safe") space when (isImportDeclQualified ideclQualified && not useQualifiedPost) (txt "qualified") space case ideclPkgQual of Nothing -> return () Just slit -> atom slit space inci $ do located ideclName atom when (isImportDeclQualified ideclQualified && useQualifiedPost) (space >> txt "qualified") case ideclAs of Nothing -> return () Just l -> do space txt "as" space located l atom space case ideclHiding of Nothing -> return () Just (hiding, _) -> when hiding (txt "hiding") case ideclHiding of Nothing -> return () Just (_, L _ xs) -> do breakpoint parens N $ do layout <- getLayout sep breakpoint (\(p, l) -> sitcc (located l (p_lie layout p))) (attachRelativePos xs) newline p_hsmodImport _ (XImportDecl x) = noExtCon x p_lie :: Layout -> RelativePos -> IE GhcPs -> R () p_lie encLayout relativePos = \case IEVar NoExtField l1 -> do located l1 p_ieWrappedName p_comma IEThingAbs NoExtField l1 -> do located l1 p_ieWrappedName p_comma IEThingAll NoExtField l1 -> do located l1 p_ieWrappedName space txt "(..)" p_comma IEThingWith NoExtField l1 w xs _ -> sitcc $ do located l1 p_ieWrappedName breakpoint inci $ do let names :: [R ()] names = located' p_ieWrappedName <$> xs parens N . sep commaDel sitcc $ case w of NoIEWildcard -> names IEWildcard n -> let (before, after) = splitAt n names in before ++ [txt ".."] ++ after p_comma IEModuleContents NoExtField l1 -> do located l1 p_hsmodName p_comma IEGroup NoExtField n str -> do case relativePos of SinglePos -> return () FirstPos -> return () MiddlePos -> newline LastPos -> newline p_hsDocString (Asterisk n) False (noLoc str) IEDoc NoExtField str -> p_hsDocString Pipe False (noLoc str) IEDocNamed NoExtField str -> p_hsDocName str XIE x -> noExtCon x where p_comma = case encLayout of SingleLine -> case relativePos of SinglePos -> return () FirstPos -> comma MiddlePos -> comma LastPos -> return () MultiLine -> comma ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Module.hs0000644000000000000000000000427207346545000017521 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of modules. module Ormolu.Printer.Meat.Module ( p_hsModule, ) where import Control.Monad import qualified Data.Text as T import GHC import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma import Ormolu.Parser.Shebang import Ormolu.Printer.Combinators import Ormolu.Printer.Comments import Ormolu.Printer.Meat.Common import Ormolu.Printer.Meat.Declaration import Ormolu.Printer.Meat.Declaration.Warning import Ormolu.Printer.Meat.ImportExport import Ormolu.Printer.Meat.Pragma -- | Render a module. p_hsModule :: -- | Stack header Maybe (RealLocated Comment) -> -- | Shebangs [Shebang] -> -- | Pragmas and the associated comments [([RealLocated Comment], Pragma)] -> -- | Whether to use postfix qualified imports Bool -> -- | AST to print HsModule GhcPs -> R () p_hsModule mstackHeader shebangs pragmas qualifiedPost HsModule {..} = do let deprecSpan = maybe [] (\(L s _) -> [s]) hsmodDeprecMessage exportSpans = maybe [] (\(L s _) -> [s]) hsmodExports switchLayout (deprecSpan <> exportSpans) $ do forM_ shebangs $ \(Shebang x) -> located x $ \shebang -> do txt (T.pack shebang) newline forM_ mstackHeader $ \(L spn comment) -> do spitCommentNow spn comment newline newline p_pragmas pragmas newline case hsmodName of Nothing -> return () Just hsmodName' -> do located hsmodName' $ \name -> do forM_ hsmodHaddockModHeader (p_hsDocString Pipe True) p_hsmodName name breakpoint forM_ hsmodDeprecMessage $ \w -> do located' p_moduleWarning w breakpoint case hsmodExports of Nothing -> return () Just l -> do located l $ \exports -> do inci (p_hsmodExports exports) breakpoint txt "where" newline newline forM_ (normalizeImports hsmodImports) (located' (p_hsmodImport qualifiedPost)) newline switchLayout (getLoc <$> hsmodDecls) $ do p_hsDecls Free hsmodDecls newline spitRemainingComments ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Pragma.hs0000644000000000000000000000515707346545000017506 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} -- | Pretty-printing of language pragmas. module Ormolu.Printer.Meat.Pragma ( p_pragmas, ) where import Control.Monad import Data.Char (isUpper) import qualified Data.List as L import Data.Maybe (listToMaybe) import qualified Data.Text as T import Ormolu.Parser.CommentStream import Ormolu.Parser.Pragma (Pragma (..)) import Ormolu.Printer.Combinators import Ormolu.Printer.Comments import SrcLoc -- | Pragma classification. data PragmaTy = Language LanguagePragmaClass | OptionsGHC | OptionsHaddock deriving (Eq, Ord) -- | Language pragma classification. -- -- The order in which language pragmas are put in the input sometimes -- matters. This is because some language extensions can enable other -- extensions, yet the extensions coming later in the list have the ability -- to change it. So here we classify all extensions by assigning one of the -- four groups to them. Then we only sort inside of the groups. -- -- 'Ord' instance of this data type is what affects the sorting. -- -- See also: data LanguagePragmaClass = -- | All other extensions Normal | -- | Extensions starting with "No" Disabling | -- | Extensions that should go after everything else Final deriving (Eq, Ord) -- | Print a collection of 'Pragma's with their associated comments. p_pragmas :: [([RealLocated Comment], Pragma)] -> R () p_pragmas ps = do let prepare = L.sortOn snd . L.nub . concatMap analyze analyze = \case (cs, PragmaLanguage xs) -> let f x = (cs, (Language (classifyLanguagePragma x), x)) in f <$> xs (cs, PragmaOptionsGHC x) -> [(cs, (OptionsGHC, x))] (cs, PragmaOptionsHaddock x) -> [(cs, (OptionsHaddock, x))] forM_ (prepare ps) $ \(cs, (pragmaTy, x)) -> p_pragma cs pragmaTy x p_pragma :: [RealLocated Comment] -> PragmaTy -> String -> R () p_pragma comments ty x = do forM_ comments $ \(L l comment) -> do spitCommentNow l comment newline txt "{-# " txt $ case ty of Language _ -> "LANGUAGE" OptionsGHC -> "OPTIONS_GHC" OptionsHaddock -> "OPTIONS_HADDOCK" space txt (T.pack x) txt " #-}" newline -- | Classify a 'LanguagePragma'. classifyLanguagePragma :: String -> LanguagePragmaClass classifyLanguagePragma = \case "ImplicitPrelude" -> Final "CUSKs" -> Final str -> case splitAt 2 str of ("No", rest) -> case listToMaybe rest of Nothing -> Normal Just x -> if isUpper x then Disabling else Normal _ -> Normal ormolu-0.1.2.0/src/Ormolu/Printer/Meat/Type.hs0000644000000000000000000002026207346545000017212 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} -- | Rendering of types. module Ormolu.Printer.Meat.Type ( p_hsType, p_hsTypePostDoc, hasDocStrings, p_hsContext, p_hsTyVarBndr, p_forallBndrs, p_conDeclFields, tyVarsToTypes, ) where import Data.Data (Data) import GHC hiding (isPromoted) import Ormolu.Printer.Combinators import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit) import Ormolu.Printer.Operators import Ormolu.Utils p_hsType :: HsType GhcPs -> R () p_hsType t = p_hsType' (hasDocStrings t) PipeStyle t p_hsTypePostDoc :: HsType GhcPs -> R () p_hsTypePostDoc t = p_hsType' (hasDocStrings t) CaretStyle t -- | How to render Haddocks associated with a type. data TypeDocStyle = PipeStyle | CaretStyle p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R () p_hsType' multilineArgs docStyle = \case HsForAllTy NoExtField visibility bndrs t -> do p_forallBndrs visibility p_hsTyVarBndr bndrs interArgBreak p_hsTypeR (unLoc t) HsQualTy NoExtField qs t -> do located qs p_hsContext space txt "=>" interArgBreak case unLoc t of HsQualTy {} -> p_hsTypeR (unLoc t) HsFunTy {} -> p_hsTypeR (unLoc t) _ -> located t p_hsTypeR HsTyVar NoExtField p n -> do case p of IsPromoted -> do txt "'" case showOutputable (unLoc n) of _ : '\'' : _ -> space _ -> return () NotPromoted -> return () p_rdrName n HsAppTy NoExtField f x -> do let -- In order to format type applications with multiple parameters -- nicer, traverse the AST to gather the function and all the -- parameters together. gatherArgs f' knownArgs = case f' of L _ (HsAppTy _ l r) -> gatherArgs l (r : knownArgs) _ -> (f', knownArgs) (func, args) = gatherArgs f [x] switchLayout (getLoc f : fmap getLoc args) . sitcc $ do located func p_hsType breakpoint inci $ sep breakpoint (located' p_hsType) args HsAppKindTy _ ty kd -> sitcc $ do -- The first argument is the location of the "@..." part. Not 100% sure, -- but I think we can ignore it as long as we use 'located' on both the -- type and the kind. located ty p_hsType breakpoint inci $ do txt "@" located kd p_hsType HsFunTy NoExtField x y@(L _ y') -> do located x p_hsType space txt "->" interArgBreak case y' of HsFunTy {} -> p_hsTypeR y' _ -> located y p_hsTypeR HsListTy NoExtField t -> located t (brackets N . p_hsType) HsTupleTy NoExtField tsort xs -> let parens' = case tsort of HsUnboxedTuple -> parensHash N HsBoxedTuple -> parens N HsConstraintTuple -> parens N HsBoxedOrConstraintTuple -> parens N in parens' $ sep commaDel (sitcc . located' p_hsType) xs HsSumTy NoExtField xs -> parensHash N $ sep (txt "|" >> breakpoint) (sitcc . located' p_hsType) xs HsOpTy NoExtField x op y -> sitcc $ let opTree = OpBranch (tyOpTree x) op (tyOpTree y) in p_tyOpTree (reassociateOpTree Just opTree) HsParTy NoExtField t -> parens N (located t p_hsType) HsIParamTy NoExtField n t -> sitcc $ do located n atom space txt "::" breakpoint inci (located t p_hsType) HsStarTy NoExtField _ -> txt "*" HsKindSig NoExtField t k -> sitcc $ do located t p_hsType space txt "::" breakpoint inci (located k p_hsType) HsSpliceTy NoExtField splice -> p_hsSplice splice HsDocTy NoExtField t str -> case docStyle of PipeStyle -> do p_hsDocString Pipe True str located t p_hsType CaretStyle -> do located t p_hsType newline p_hsDocString Caret False str HsBangTy NoExtField (HsSrcBang _ u s) t -> do case u of SrcUnpack -> txt "{-# UNPACK #-}" >> space SrcNoUnpack -> txt "{-# NOUNPACK #-}" >> space NoSrcUnpack -> return () case s of SrcLazy -> txt "~" SrcStrict -> txt "!" NoSrcStrict -> return () located t p_hsType HsRecTy NoExtField fields -> p_conDeclFields fields HsExplicitListTy NoExtField p xs -> do case p of IsPromoted -> txt "'" NotPromoted -> return () brackets N $ do -- If both this list itself and the first element is promoted, -- we need to put a space in between or it fails to parse. case (p, xs) of (IsPromoted, L _ t : _) | isPromoted t -> space _ -> return () sep commaDel (sitcc . located' p_hsType) xs HsExplicitTupleTy NoExtField xs -> do txt "'" parens N $ do case xs of L _ t : _ | isPromoted t -> space _ -> return () sep commaDel (located' p_hsType) xs HsTyLit NoExtField t -> case t of HsStrTy (SourceText s) _ -> p_stringLit s a -> atom a HsWildCardTy NoExtField -> txt "_" XHsType (NHsCoreTy t) -> atom t where isPromoted = \case HsTyVar _ IsPromoted _ -> True HsExplicitTupleTy {} -> True HsExplicitListTy {} -> True _ -> False interArgBreak = if multilineArgs then newline else breakpoint p_hsTypeR = p_hsType' multilineArgs docStyle -- | Return 'True' if at least one argument in 'HsType' has a doc string -- attached to it. hasDocStrings :: HsType GhcPs -> Bool hasDocStrings = \case HsDocTy {} -> True HsFunTy _ (L _ x) (L _ y) -> hasDocStrings x || hasDocStrings y _ -> False p_hsContext :: HsContext GhcPs -> R () p_hsContext = \case [] -> txt "()" [x] -> located x p_hsType xs -> parens N $ sep commaDel (sitcc . located' p_hsType) xs p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R () p_hsTyVarBndr = \case UserTyVar NoExtField x -> p_rdrName x KindedTyVar NoExtField l k -> parens N $ do located l atom space txt "::" breakpoint inci (located k p_hsType) XTyVarBndr x -> noExtCon x -- | Render several @forall@-ed variables. p_forallBndrs :: Data a => ForallVisFlag -> (a -> R ()) -> [Located a] -> R () p_forallBndrs ForallInvis _ [] = txt "forall." p_forallBndrs ForallVis _ [] = txt "forall ->" p_forallBndrs vis p tyvars = switchLayout (getLoc <$> tyvars) $ do txt "forall" breakpoint inci $ do sitcc $ sep breakpoint (sitcc . located' p) tyvars case vis of ForallInvis -> txt "." ForallVis -> space >> txt "->" p_conDeclFields :: [LConDeclField GhcPs] -> R () p_conDeclFields xs = braces N $ sep commaDel (sitcc . located' p_conDeclField) xs p_conDeclField :: ConDeclField GhcPs -> R () p_conDeclField ConDeclField {..} = do mapM_ (p_hsDocString Pipe True) cd_fld_doc sitcc $ sep commaDel (located' (p_rdrName . rdrNameFieldOcc)) cd_fld_names space txt "::" breakpoint sitcc . inci $ p_hsType (unLoc cd_fld_type) p_conDeclField (XConDeclField x) = noExtCon x tyOpTree :: LHsType GhcPs -> OpTree (LHsType GhcPs) (Located RdrName) tyOpTree (L _ (HsOpTy NoExtField l op r)) = OpBranch (tyOpTree l) op (tyOpTree r) tyOpTree n = OpNode n p_tyOpTree :: OpTree (LHsType GhcPs) (Located RdrName) -> R () p_tyOpTree (OpNode n) = located n p_hsType p_tyOpTree (OpBranch l op r) = do switchLayout [opTreeLoc l] $ p_tyOpTree l breakpoint inci . switchLayout [opTreeLoc r] $ do p_rdrName op space p_tyOpTree r ---------------------------------------------------------------------------- -- Conversion functions tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs] tyVarsToTypes = \case HsQTvs {..} -> fmap tyVarToType <$> hsq_explicit XLHsQTyVars x -> noExtCon x tyVarToType :: HsTyVarBndr GhcPs -> HsType GhcPs tyVarToType = \case UserTyVar NoExtField tvar -> HsTyVar NoExtField NotPromoted tvar KindedTyVar NoExtField tvar kind -> -- Note: we always add parentheses because for whatever reason GHC does -- not use HsParTy for left-hand sides of declarations. Please see -- . This is fine as -- long as 'tyVarToType' does not get applied to right-hand sides of -- declarations. HsParTy NoExtField . noLoc $ HsKindSig NoExtField (noLoc (HsTyVar NoExtField NotPromoted tvar)) kind XTyVarBndr x -> noExtCon x ormolu-0.1.2.0/src/Ormolu/Printer/Operators.hs0000644000000000000000000001410707346545000017362 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} -- | This module helps handle operator chains composed of different -- operators that may have different precedence and fixities. module Ormolu.Printer.Operators ( OpTree (..), opTreeLoc, reassociateOpTree, ) where import Data.Function (on) import qualified Data.List as L import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import Data.Maybe (fromMaybe, mapMaybe) import GHC import OccName (occNameString) import Ormolu.Utils (unSrcSpan) -- | Intermediate representation of operator trees. It has two type -- parameters: @ty@ is the type of sub-expressions, while @op@ is the type -- of operators. data OpTree ty op = OpNode ty | OpBranch (OpTree ty op) op (OpTree ty op) -- | Return combined 'SrcSpan's of all elements in this 'OpTree'. opTreeLoc :: OpTree (Located a) b -> SrcSpan opTreeLoc (OpNode (L l _)) = l opTreeLoc (OpBranch l _ r) = combineSrcSpans (opTreeLoc l) (opTreeLoc r) -- | Re-associate an 'OpTree' taking into account automagically inferred -- relative precedence of operators. Users are expected to first construct -- an initial 'OpTree', then re-associate it using this function before -- printing. reassociateOpTree :: -- | How to get name of an operator (op -> Maybe RdrName) -> -- | Original 'OpTree' OpTree (Located ty) (Located op) -> -- | Re-associated 'OpTree' OpTree (Located ty) (Located op) reassociateOpTree getOpName opTree = reassociateOpTreeWith (buildFixityMap getOpName normOpTree) (getOpName . unLoc) normOpTree where normOpTree = normalizeOpTree opTree -- | Re-associate an 'OpTree' given the map with operator fixities. reassociateOpTreeWith :: forall ty op. -- | Fixity map for operators Map String 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 s <- occNameString . rdrNameOcc <$> getOpName op M.lookup s fixityMap -- Here, left branch is already associated and the root alongside with -- the right branch is right-associated. This function picks up one item -- from the right and inserts it correctly to the left. -- -- Also, we are using the 'compareFixity' function which tells if the -- expression should associate to right. go :: OpTree ty op -> OpTree ty op -- base cases 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' -- | A score assigned to an operator. data Score = -- | The operator was placed at the beginning of a line AtBeginning Int | -- | The operator was placed at the end of a line AtEnd | -- | The operator was placed in between arguments on a single line InBetween deriving (Eq, Ord) -- | Build a map of inferred 'Fixity's from an 'OpTree'. buildFixityMap :: forall ty op. -- | How to get the name of an operator (op -> Maybe RdrName) -> -- | Operator tree OpTree (Located ty) (Located op) -> -- | Fixity map Map String Fixity buildFixityMap getOpName opTree = addOverrides . M.fromList . concatMap (\(i, ns) -> map (\(n, _) -> (n, fixity i InfixL)) ns) . zip [2 ..] . L.groupBy ((==) `on` snd) . selectScores $ score opTree where addOverrides :: Map String Fixity -> Map String Fixity addOverrides m = M.fromList [ ("$", fixity 0 InfixR), (":", fixity 1 InfixR), (".", fixity 100 InfixL) ] `M.union` m fixity = Fixity NoSourceText score :: OpTree (Located ty) (Located op) -> [(String, Score)] score (OpNode _) = [] score (OpBranch l o r) = fromMaybe (score r) $ do -- If we fail to get any of these, 'defaultFixity' will be used by -- '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 <- occNameString . rdrNameOcc <$> getOpName (unLoc o) let s | le < ob = AtBeginning oc | oe < rb = AtEnd | otherwise = InBetween return $ (opName, s) : score r selectScores :: [(String, Score)] -> [(String, Score)] selectScores = L.sortOn snd . mapMaybe ( \case [] -> Nothing xs@((n, _) : _) -> Just (n, selectScore $ map snd xs) ) . L.groupBy ((==) `on` fst) . L.sort selectScore :: [Score] -> Score selectScore xs = case filter (/= InBetween) xs of [] -> InBetween xs' -> maximum xs' ---------------------------------------------------------------------------- -- 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)) ormolu-0.1.2.0/src/Ormolu/Printer/SpanStream.hs0000644000000000000000000000240307346545000017455 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -- | Build span stream from AST. module Ormolu.Printer.SpanStream ( SpanStream (..), mkSpanStream, ) where import Data.DList (DList) import qualified Data.DList as D import Data.Data (Data) import Data.Generics (everything, ext2Q) import Data.List (sortOn) import Data.Typeable (cast) import SrcLoc -- | A stream of 'RealSrcSpan's in ascending order. This allows us to tell -- e.g. whether there is another \"located\" element of AST between current -- element and comment we're considering for printing. newtype SpanStream = SpanStream [RealSrcSpan] deriving (Eq, Show, Data, Semigroup, Monoid) -- | Create 'SpanStream' from a data structure containing \"located\" -- elements. mkSpanStream :: Data a => -- | Data structure to inspect (AST) a -> SpanStream mkSpanStream a = SpanStream . sortOn realSrcSpanStart . D.toList $ everything mappend (const mempty `ext2Q` queryLocated) a where queryLocated :: (Data e0) => GenLocated e0 e1 -> DList RealSrcSpan queryLocated (L mspn _) = case cast mspn :: Maybe SrcSpan of Nothing -> mempty Just (UnhelpfulSpan _) -> mempty Just (RealSrcSpan spn) -> D.singleton spn ormolu-0.1.2.0/src/Ormolu/Processing/0000755000000000000000000000000007346545000015536 5ustar0000000000000000ormolu-0.1.2.0/src/Ormolu/Processing/Common.hs0000644000000000000000000000122207346545000017317 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Common definitions for pre- and post- processing. module Ormolu.Processing.Common ( OrmoluState (..), startDisabling, endDisabling, ) where import Data.String (IsString (..)) -- | Ormolu state. data OrmoluState = -- | Enabled OrmoluEnabled | -- | Disabled OrmoluDisabled deriving (Eq, Show) -- | Marker for the beginning of the region where Ormolu should be disabled. startDisabling :: IsString s => s startDisabling = "{- ORMOLU_DISABLE_START" -- | Marker for the end of the region where Ormolu should be disabled. endDisabling :: IsString s => s endDisabling = "ORMOLU_DISABLE_END -}" ormolu-0.1.2.0/src/Ormolu/Processing/Cpp.hs0000644000000000000000000000350307346545000016615 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Support for CPP. module Ormolu.Processing.Cpp ( State (..), processLine, unmaskLine, ) where import Control.Monad import Data.Char (isSpace) import qualified Data.List as L import Data.Maybe (isJust) import Data.String import Data.Text (Text) import qualified Data.Text as T -- | State of the CPP processor. data State = -- | Outside of CPP directives Outside | -- | In a conditional expression InConditional | -- | In a continuation (after @\\@) InContinuation deriving (Eq, Show) -- | Automatically mask the line when needed and update the 'State'. processLine :: String -> State -> (String, State) processLine line state | for "define " = (masked, state') | for "include " = (masked, state') | for "undef " = (masked, state') | for "ifdef " = (masked, InConditional) | for "ifndef " = (masked, InConditional) | for "if " = (masked, InConditional) | for "else" = (masked, InConditional) | for "elif" = (masked, InConditional) | for "endif" = (masked, state') | otherwise = case state of Outside -> (line, Outside) InConditional -> (masked, InConditional) InContinuation -> (masked, state') where for directive = isJust $ do s <- dropWhile isSpace <$> L.stripPrefix "#" line void (L.stripPrefix directive s) masked = maskLine line state' = if "\\" `L.isSuffixOf` line then InContinuation else Outside -- | Mask the given line. maskLine :: String -> String maskLine x = maskPrefix ++ x -- | If the given line is masked, unmask it. Otherwise return the line -- unchanged. unmaskLine :: Text -> Text unmaskLine x = case T.stripPrefix maskPrefix (T.stripStart x) of Nothing -> x Just x' -> x' -- | Mask prefix for CPP. maskPrefix :: IsString s => s maskPrefix = "-- ORMOLU_CPP_MASK" ormolu-0.1.2.0/src/Ormolu/Processing/Postprocess.hs0000644000000000000000000000132507346545000020417 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Postprocessing for the results of printing. module Ormolu.Processing.Postprocess ( postprocess, ) where import Data.Text (Text) import qualified Data.Text as T import Ormolu.Processing.Common import qualified Ormolu.Processing.Cpp as Cpp -- | Postprocess output of the formatter. postprocess :: -- | Desired indentation level Int -> -- | Input to process Text -> Text postprocess indent = T.unlines . fmap indentLine . fmap Cpp.unmaskLine . filter (not . magicComment) . T.lines where magicComment (T.stripStart -> x) = x == startDisabling || x == endDisabling indentLine x = T.replicate indent " " <> x ormolu-0.1.2.0/src/Ormolu/Processing/Preprocess.hs0000644000000000000000000001160207346545000020217 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE RecordWildCards #-} -- | Preprocessing for input source code. module Ormolu.Processing.Preprocess ( preprocess, ) where import Control.Monad import Data.Char (isSpace) import qualified Data.List as L import Data.Maybe (isJust, maybeToList) import FastString import Ormolu.Config (RegionDeltas (..)) import Ormolu.Parser.Shebang (isShebang) import Ormolu.Processing.Common import qualified Ormolu.Processing.Cpp as Cpp import SrcLoc -- | Transform given input possibly returning comments extracted from it. -- This handles LINE pragmas, CPP, shebangs, and the magic comments for -- enabling\/disabling of Ormolu. preprocess :: -- | File name, just to use in the spans FilePath -> -- | Input to process String -> -- | Region deltas RegionDeltas -> -- | Literal prefix, pre-processed input, literal suffix, extra comments (String, String, String, [Located String]) preprocess path input RegionDeltas {..} = go 1 OrmoluEnabled Cpp.Outside id id regionLines where (prefixLines, otherLines) = splitAt regionPrefixLength (lines input) (regionLines, suffixLines) = let regionLength = length otherLines - regionSuffixLength in splitAt regionLength otherLines go !n ormoluState cppState inputSoFar csSoFar = \case [] -> let input' = unlines (inputSoFar []) in ( unlines prefixLines, case ormoluState of OrmoluEnabled -> input' OrmoluDisabled -> input' ++ endDisabling, unlines suffixLines, csSoFar [] ) (x : xs) -> let (x', ormoluState', cppState', cs) = processLine path n ormoluState cppState x in go (n + 1) ormoluState' cppState' (inputSoFar . (x' :)) (csSoFar . (maybeToList cs ++)) xs -- | Transform a given line possibly returning a comment extracted from it. processLine :: -- | File name, just to use in the spans FilePath -> -- | Line number of this line Int -> -- | Whether Ormolu is currently enabled OrmoluState -> -- | CPP state Cpp.State -> -- | The actual line String -> -- | Adjusted line and possibly a comment extracted from it (String, OrmoluState, Cpp.State, Maybe (Located String)) processLine path n ormoluState Cpp.Outside line | "{-# LINE" `L.isPrefixOf` line = let (pragma, res) = getPragma line size = length pragma ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (size + 1)) in (res, ormoluState, Cpp.Outside, Just (L ss pragma)) | isOrmoluEnable line = case ormoluState of OrmoluEnabled -> (enableMarker, OrmoluEnabled, Cpp.Outside, Nothing) OrmoluDisabled -> (endDisabling ++ enableMarker, OrmoluEnabled, Cpp.Outside, Nothing) | isOrmoluDisable line = case ormoluState of OrmoluEnabled -> (disableMarker ++ startDisabling, OrmoluDisabled, Cpp.Outside, Nothing) OrmoluDisabled -> (disableMarker, OrmoluDisabled, Cpp.Outside, Nothing) | isShebang line = let ss = mkSrcSpan (mkSrcLoc' 1) (mkSrcLoc' (length line)) in ("", ormoluState, Cpp.Outside, Just (L ss line)) | otherwise = let (line', cppState') = Cpp.processLine line Cpp.Outside in (line', ormoluState, cppState', Nothing) where mkSrcLoc' = mkSrcLoc (mkFastString path) n processLine _ _ ormoluState cppState line = let (line', cppState') = Cpp.processLine line cppState in (line', ormoluState, cppState', Nothing) -- | Take a line pragma and output its replacement (where line pragma is -- replaced with spaces) and the contents of the pragma itself. getPragma :: -- | Pragma line to analyze String -> -- | Contents of the pragma and its replacement line (String, String) getPragma [] = error "Ormolu.Preprocess.getPragma: input must not be empty" getPragma s@(x : xs) | "#-}" `L.isPrefixOf` s = ("#-}", " " ++ drop 3 s) | otherwise = let (prag, remline) = getPragma xs in (x : prag, ' ' : remline) -- | Canonical enable marker. enableMarker :: String enableMarker = "{- ORMOLU_ENABLE -}" -- | Canonical disable marker. disableMarker :: String disableMarker = "{- ORMOLU_DISABLE -}" -- | Return 'True' if the given string is an enabling marker. isOrmoluEnable :: String -> Bool isOrmoluEnable = magicComment "ORMOLU_ENABLE" -- | Return 'True' if the given string is a disabling marker. isOrmoluDisable :: String -> Bool isOrmoluDisable = magicComment "ORMOLU_DISABLE" -- | Construct a function for whitespace-insensitive matching of string. magicComment :: -- | What to expect String -> -- | String to test String -> -- | Whether or not the two strings watch Bool magicComment expected s0 = isJust $ do let trim = dropWhile isSpace s1 <- trim <$> L.stripPrefix "{-" (trim s0) s2 <- trim <$> L.stripPrefix expected s1 s3 <- L.stripPrefix "-}" s2 guard (all isSpace s3) ormolu-0.1.2.0/src/Ormolu/Utils.hs0000644000000000000000000001110707346545000015056 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} -- | Random utilities used by the code. module Ormolu.Utils ( RelativePos (..), attachRelativePos, combineSrcSpans', notImplemented, showOutputable, splitDocString, typeArgToType, unSrcSpan, incSpanLine, separatedByBlank, separatedByBlankNE, onTheSameLine, removeIndentation, ) where import Data.Char (isSpace) import Data.List (dropWhileEnd) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text as T import GHC import GHC.DynFlags (baseDynFlags) import qualified Outputable as GHC -- | Relative positions in a list. data RelativePos = SinglePos | FirstPos | MiddlePos | LastPos deriving (Eq, Show) -- | Attach 'RelativePos'es to elements of a given list. attachRelativePos :: [a] -> [(RelativePos, a)] attachRelativePos = \case [] -> [] [x] -> [(SinglePos, x)] (x : xs) -> (FirstPos, x) : markLast xs where markLast [] = [] markLast [x] = [(LastPos, x)] markLast (x : xs) = (MiddlePos, x) : markLast xs -- | Combine all source spans from the given list. combineSrcSpans' :: NonEmpty SrcSpan -> SrcSpan combineSrcSpans' (x :| xs) = foldr combineSrcSpans x xs -- | Placeholder for things that are not yet implemented. notImplemented :: String -> a notImplemented msg = error $ "not implemented yet: " ++ msg -- | Pretty-print an 'GHC.Outputable' thing. showOutputable :: GHC.Outputable o => o -> String showOutputable = GHC.showSDoc baseDynFlags . GHC.ppr -- | Split and normalize a doc string. The result is a list of lines that -- make up the comment. splitDocString :: HsDocString -> [Text] splitDocString docStr = case r of [] -> [""] _ -> r where r = fmap escapeLeadingDollar . dropPaddingSpace . dropWhileEnd T.null . fmap (T.stripEnd . T.pack) . lines $ unpackHDS docStr -- We cannot have the first character to be a dollar because in that -- case it'll be a parse error (apparently collides with named docs -- syntax @-- $name@ somehow). escapeLeadingDollar txt = case T.uncons txt of Just ('$', _) -> T.cons '\\' txt _ -> txt dropPaddingSpace xs = case dropWhile T.null xs of [] -> [] (x : _) -> let leadingSpace txt = case T.uncons txt of Just (' ', _) -> True _ -> False dropSpace txt = if leadingSpace txt then T.drop 1 txt else txt in if leadingSpace x then dropSpace <$> xs else xs -- | Get 'LHsType' out of 'LHsTypeArg'. typeArgToType :: LHsTypeArg p -> LHsType p typeArgToType = \case HsValArg tm -> tm HsTypeArg _ ty -> ty HsArgPar _ -> notImplemented "HsArgPar" -- | Get 'RealSrcSpan' out of 'SrcSpan' if the span is “helpful”. unSrcSpan :: SrcSpan -> Maybe RealSrcSpan unSrcSpan = \case RealSrcSpan r -> Just r UnhelpfulSpan _ -> Nothing -- | Increment line number in a 'SrcSpan'. incSpanLine :: Int -> SrcSpan -> SrcSpan incSpanLine i = \case RealSrcSpan s -> let start = realSrcSpanStart s end = realSrcSpanEnd s incLine x = let file = srcLocFile x line = srcLocLine x col = srcLocCol x in mkRealSrcLoc file (line + i) col in RealSrcSpan (mkRealSrcSpan (incLine start) (incLine end)) UnhelpfulSpan x -> UnhelpfulSpan x -- | Do two declarations have a blank between them? separatedByBlank :: (a -> SrcSpan) -> a -> a -> Bool separatedByBlank loc a b = fromMaybe False $ do endA <- srcSpanEndLine <$> unSrcSpan (loc a) startB <- srcSpanStartLine <$> unSrcSpan (loc b) pure (startB - endA >= 2) -- | Do two declaration groups have a blank between them? separatedByBlankNE :: (a -> SrcSpan) -> NonEmpty a -> NonEmpty a -> Bool separatedByBlankNE loc a b = separatedByBlank loc (NE.last a) (NE.head b) -- | Return 'True' if one span ends on the same line the second one starts. onTheSameLine :: SrcSpan -> SrcSpan -> Bool onTheSameLine a b = isOneLineSpan (mkSrcSpan (srcSpanEnd a) (srcSpanStart b)) -- | Remove indentation from a given 'String'. Return the input with -- indentation removed and the detected indentation level. removeIndentation :: String -> (String, Int) removeIndentation (lines -> xs) = (unlines (drop n <$> xs), n) where n = minimum (getIndent <$> xs) getIndent y = if all isSpace y then 0 else length (takeWhile isSpace y) ormolu-0.1.2.0/tests/Ormolu/Parser/0000755000000000000000000000000007346545000015231 5ustar0000000000000000ormolu-0.1.2.0/tests/Ormolu/Parser/PragmaSpec.hs0000644000000000000000000000210007346545000017600 0ustar0000000000000000module Ormolu.Parser.PragmaSpec (spec) where import Ormolu.Parser.Pragma import Test.Hspec spec :: Spec spec = describe "parsePragma" $ do stdTest "{-# LANGUAGE Foo #-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-# language Foo #-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-#LANGUAGE Foo#-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-# LANGUAGE Foo#-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-#language Foo#-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-# lAngUAGe Foo #-}" (Just (PragmaLanguage ["Foo"])) stdTest "{-# LANGUAGE Foo, Bar #-}" (Just (PragmaLanguage ["Foo", "Bar"])) stdTest "{-# LANGUAGE Foo Bar #-}" Nothing stdTest "{-# BOO Foo #-}" Nothing stdTest "something" Nothing stdTest "{-# LANGUAGE foo, Bar #-}" Nothing stdTest "{-# OPTIONS_GHC foo bar baz #-}" (Just $ PragmaOptionsGHC "foo bar baz") stdTest "{-#OPTIONS_HADDOCK foo, bar, baz #-}" (Just $ PragmaOptionsHaddock "foo, bar, baz") stdTest :: String -> Maybe Pragma -> Spec stdTest input result = it input $ parsePragma input `shouldBe` result ormolu-0.1.2.0/tests/Ormolu/0000755000000000000000000000000007346545000013775 5ustar0000000000000000ormolu-0.1.2.0/tests/Ormolu/PrinterSpec.hs0000644000000000000000000000607207346545000016574 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} module Ormolu.PrinterSpec (spec) where import Control.Exception import Control.Monad import Control.Monad.IO.Class import Data.List (isSuffixOf) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T import Ormolu import Path import Path.IO import qualified System.FilePath as F import Test.Hspec spec :: Spec spec = do es <- runIO locateExamples forM_ es checkExample -- | Check a single given example. checkExample :: Path Rel File -> Spec checkExample srcPath' = it (fromRelFile srcPath' ++ " works") . withNiceExceptions $ do let srcPath = examplesDir srcPath' expectedOutputPath <- deriveOutput srcPath -- 1. Given input snippet of source code parse it and pretty print it. -- 2. Parse the result of pretty-printing again and make sure that AST -- is the same as AST of the original snippet. (This happens in -- 'ormoluFile' automatically.) formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath) -- 3. Check the output against expected output. Thus all tests should -- include two files: input and expected output. -- T.writeFile (fromRelFile expectedOutputPath) formatted0 expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath shouldMatch False formatted0 expected -- 4. Check that running the formatter on the output produces the same -- output again (the transformation is idempotent). formatted1 <- ormolu defaultConfig "" (T.unpack formatted0) shouldMatch True formatted1 formatted0 -- | Build list of examples for testing. locateExamples :: IO [Path Rel File] locateExamples = filter isInput . snd <$> listDirRecurRel examplesDir -- | Does given path look like input path (as opposed to expected output -- path)? isInput :: Path Rel File -> Bool isInput path = let s = fromRelFile path (s', exts) = F.splitExtensions s in exts == ".hs" && not ("-out" `isSuffixOf` s') -- | For given path of input file return expected name of output. deriveOutput :: Path Rel File -> IO (Path Rel File) deriveOutput path = parseRelFile $ F.addExtension (F.dropExtensions (fromRelFile path) ++ "-out") "hs" -- | A version of 'shouldBe' that is specialized to comparing 'Text' values. -- It also prints multi-line snippets in a more readable form. shouldMatch :: Bool -> Text -> Text -> Expectation shouldMatch idempotenceTest actual expected = when (actual /= expected) . expectationFailure $ unlines [ ">>>>>>>>>>>>>>>>>>>>>> expected (" ++ pass ++ "):", T.unpack expected, ">>>>>>>>>>>>>>>>>>>>>> but got:", T.unpack actual ] where pass = if idempotenceTest then "idempotence pass" else "first pass" examplesDir :: Path Rel Dir examplesDir = $(mkRelDir "data/examples") -- | Inside this wrapper 'OrmoluException' will be caught and displayed -- nicely using 'displayException'. withNiceExceptions :: -- | Action that may throw the exception Expectation -> Expectation withNiceExceptions m = m `catch` h where h :: OrmoluException -> IO () h = expectationFailure . displayException ormolu-0.1.2.0/tests/0000755000000000000000000000000007346545000012520 5ustar0000000000000000ormolu-0.1.2.0/tests/Spec.hs0000644000000000000000000000005407346545000013745 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}