diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +## Fourmolu 0.9.0.0 + +New configuration options: + +* Add `let-style` and `in-style` configuration options ([#229](https://github.com/fourmolu/fourmolu/pull/229)). The default is set to `let-style: auto` and `in-style: right-align`, which should not reformat already formatted files, but allows users to format with `newline` without additional configuration. +* Add `unicode` configuration ([#206](https://github.com/fourmolu/fourmolu/pull/206)) + +Bug fixes: + +* Fix some edge cases with function arrows ([#247](https://github.com/fourmolu/fourmolu/pull/247)) +* Fix formatting of module header + export lists when `WARNING` or `DEPRECATED` pragma is present ([#244](https://github.com/fourmolu/fourmolu/pull/244)) +* Fixed a bug where an extra space was inserted before promoted types (e.g. `foo @'True`) ([#211](https://github.com/fourmolu/fourmolu/pull/211)) +* When `--respectful` is enabled, a `where` keyword on the line after the export list will not be moved up to the end of the previous line. ([#167](https://github.com/fourmolu/fourmolu/issues/167)) + ## Fourmolu 0.8.2.0 * Add `multi-line-compact` option to `haddock-style` that will output `{-|` for multiline haddocks instead of `{- |` ([#130](https://github.com/fourmolu/fourmolu/pull/130)) diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -41,19 +41,24 @@ ### Available options -| Configuration option | Valid options | Description | -|--------------------------|-----------------|-------------| -| `indentation` | any integer | Number of spaces to use as indentation | -| `function-arrows` | `trailing`, `leading`| How to format arrows in type signatures | -| `comma-style` | `leading`, `trailing` | Where to put the comma in lists, tuples, etc. | -| `import-export-style` | `leading`, `trailing`, `diff-friendly` | How to format multiline import/export lists (`diff-friendly` lists have trailing commas but keep the open-parentheses on the same line as the `import` line) | -| `indent-wheres` | `true`, `false` | `false` means save space by only half-indenting the `where` keyword | -| `record-brace-space` | `true`, `false` | `rec {x = 1}` vs `rec{x = 1}` | -| `newlines-between-decls` | any integer | number of newlines between top-level declarations | -| `haddock-style` | `single-line`, `multi-line`, `multi-line-compact` | Whether multiline haddocks should use `-- \|`, `{- \|`, or `{-\|` (single-line haddocks will always use `--` for now) | -| `respectful` | `true`, `false` | Whether to respect user-specified newlines, e.g. in import groupings | -| `fixities` | A list of strings | See the "Language extensions, dependencies, and fixities" section below | +Defaults are in bold. +| Configuration option | Valid options | Description +|--------------------------|-------------------------------------------------------|------------- +| `indentation` | any non-negative integer (**`4`**) | How many spaces to use as an indent +| `function-arrows` | **`trailing`**, `leading` | Where to place arrows in type signatures +| `comma-style` | **`leading`**, `trailing` | Where to place commas in lists, tuples, etc. +| `import-export-style` | `leading`, `trailing`, **`diff-friendly`** | How to format multiline import/export lists (`diff-friendly` lists have trailing commas but keep the opening parenthesis on the same line as `import`) +| `indent-wheres` | `true`, **`false`** | Use an extra level of indentation _vs_ only half-indent the `where` keyword +| `record-brace-space` | `true`, **`false`** | `rec {x = 1}` _vs_ `rec{x = 1}` +| `newlines-between-decls` | any integer (**`1`**) | Number of newlines between top-level declarations +| `haddock-style` | `single-line`, **`multi-line`**, `multi-line-compact` | Use `-- \|`, `{- \|`, or `{-\|` for multiline haddocks (single-line haddocks always use `--`) +| `let-style` | `inline`, `newline`, **`auto`**, `mixed` | How to style `let` blocks (`auto` uses `newline` if there's a newline in the input and `inline` otherwise, and `mixed` uses `inline` only when the `let` has exactly one binding) +| `in-style` | `left-align`, **`right-align`** | How to align the `in` keyword with respect to `let` +| `unicode` | `always`, `detect`, **`never`** | Output Unicode syntax. With `detect` we output Unicode syntax exactly when the extension is seen to be enabled. +| `respectful` | **`true`**, `false` | Be less aggressive in reformatting input, e.g. keep empty lines in import list +| `fixities` | list of strings (**`[]`**) | See the "Language extensions, dependencies, and fixities" section below + For examples of each of these options, see the [test files](https://github.com/fourmolu/fourmolu/tree/main/data/fourmolu/). ### Specifying configuration @@ -71,8 +76,11 @@ record-brace-space: false newlines-between-decls: 1 haddock-style: multi-line +let-style: auto +in-style: right-align respectful: true fixities: [] +unicode: never ``` The configuration that most closely matches Ormolu's styling is: @@ -86,8 +94,11 @@ record-brace-space: true newlines-between-decls: 1 haddock-style: single-line +let-style: inline +in-style: right-align respectful: false fixities: [] +unicode: never ``` Command-line options override options in a configuration file. Run `fourmolu --help` to see all options. diff --git a/data/examples/declaration/data/gadt/multiline-four-out.hs b/data/examples/declaration/data/gadt/multiline-four-out.hs --- a/data/examples/declaration/data/gadt/multiline-four-out.hs +++ b/data/examples/declaration/data/gadt/multiline-four-out.hs @@ -14,12 +14,8 @@ Foo 'Int -- | But 'Bar' is also not too bad. Bar :: - Int -> - Maybe Text -> - Foo 'Bool + Int -> Maybe Text -> Foo 'Bool -- | So is 'Baz'. Baz :: - forall a. - a -> - Foo 'String + forall a. a -> Foo 'String (:~>) :: Foo a -> Foo a -> Foo a diff --git a/data/examples/declaration/data/gadt/multiline-out.hs b/data/examples/declaration/data/gadt/multiline-out.hs --- a/data/examples/declaration/data/gadt/multiline-out.hs +++ b/data/examples/declaration/data/gadt/multiline-out.hs @@ -14,12 +14,8 @@ Foo 'Int -- | But 'Bar' is also not too bad. Bar :: - Int -> - Maybe Text -> - Foo 'Bool + Int -> Maybe Text -> Foo 'Bool -- | So is 'Baz'. Baz :: - forall a. - a -> - Foo 'String + forall a. a -> Foo 'String (:~>) :: Foo a -> Foo a -> Foo a diff --git a/data/examples/declaration/data/gadt/multiple-declaration-four-out.hs b/data/examples/declaration/data/gadt/multiple-declaration-four-out.hs --- a/data/examples/declaration/data/gadt/multiple-declaration-four-out.hs +++ b/data/examples/declaration/data/gadt/multiple-declaration-four-out.hs @@ -4,12 +4,10 @@ data GADT1 a where GADT11 , GADT12 :: - Int -> - GADT1 a + Int -> GADT1 a data GADT2 a where GADT21 , GADT21 , GADT22 :: - Int -> - GADT2 a + Int -> GADT2 a diff --git a/data/examples/declaration/data/gadt/multiple-declaration-out.hs b/data/examples/declaration/data/gadt/multiple-declaration-out.hs --- a/data/examples/declaration/data/gadt/multiple-declaration-out.hs +++ b/data/examples/declaration/data/gadt/multiple-declaration-out.hs @@ -4,12 +4,10 @@ data GADT1 a where GADT11, GADT12 :: - Int -> - GADT1 a + Int -> GADT1 a data GADT2 a where GADT21, GADT21, GADT22 :: - Int -> - GADT2 a + Int -> GADT2 a diff --git a/data/examples/declaration/type/promotion-1-four-out.hs b/data/examples/declaration/type/promotion-1-four-out.hs --- a/data/examples/declaration/type/promotion-1-four-out.hs +++ b/data/examples/declaration/type/promotion-1-four-out.hs @@ -5,7 +5,7 @@ type S7 = Proxy ('( 'a, 'b)) type S8 = Proxy ('[Int, Bool]) -type E = TypeError ( 'Text "Some text") +type E = TypeError ('Text "Some text") type G = '[ '( 'Just, 'Bool)] type X = () '`PromotedInfix` () diff --git a/data/examples/declaration/type/promotion-1-out.hs b/data/examples/declaration/type/promotion-1-out.hs --- a/data/examples/declaration/type/promotion-1-out.hs +++ b/data/examples/declaration/type/promotion-1-out.hs @@ -10,7 +10,7 @@ type S8 = Proxy ('[Int, Bool]) -type E = TypeError ( 'Text "Some text") +type E = TypeError ('Text "Some text") type G = '[ '( 'Just, 'Bool)] diff --git a/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs b/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs --- a/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs +++ b/data/examples/declaration/value/function/arrow/proc-do-complex-four-out.hs @@ -31,10 +31,12 @@ , w ) -> \u -> -- Procs can have lambdas - let v = + let + v = u -- Actually never used ^ 2 - in ( returnA + in + ( returnA -< -- Just do the calculation (x + y * z) diff --git a/data/examples/declaration/value/function/arrow/proc-lets-four-out.hs b/data/examples/declaration/value/function/arrow/proc-lets-four-out.hs --- a/data/examples/declaration/value/function/arrow/proc-lets-four-out.hs +++ b/data/examples/declaration/value/function/arrow/proc-lets-four-out.hs @@ -3,10 +3,12 @@ foo f = proc a -> let b = a in f -< b bar f g = proc a -> - let h = + let + h = f . g a j = g . h - in id -< (h, j) + in + id -< (h, j) diff --git a/data/examples/declaration/value/function/blank-lines-let-four-out.hs b/data/examples/declaration/value/function/blank-lines-let-four-out.hs --- a/data/examples/declaration/value/function/blank-lines-let-four-out.hs +++ b/data/examples/declaration/value/function/blank-lines-let-four-out.hs @@ -1,6 +1,8 @@ foo = - let x = 10 + let + x = 10 y = 11 z = 12 - in x + y + z + in + x + y + z diff --git a/data/examples/fourmolu/type-app-promoted-four-out.hs b/data/examples/fourmolu/type-app-promoted-four-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/fourmolu/type-app-promoted-four-out.hs @@ -0,0 +1,1 @@ +x = foo @'True diff --git a/data/examples/fourmolu/type-app-promoted-out.hs b/data/examples/fourmolu/type-app-promoted-out.hs new file mode 100644 --- /dev/null +++ b/data/examples/fourmolu/type-app-promoted-out.hs @@ -0,0 +1,1 @@ +x = foo @'True diff --git a/data/examples/fourmolu/type-app-promoted.hs b/data/examples/fourmolu/type-app-promoted.hs new file mode 100644 --- /dev/null +++ b/data/examples/fourmolu/type-app-promoted.hs @@ -0,0 +1,1 @@ +x = foo @'True diff --git a/data/examples/module-header/multiline-with-comments-four-out.hs b/data/examples/module-header/multiline-with-comments-four-out.hs --- a/data/examples/module-header/multiline-with-comments-four-out.hs +++ b/data/examples/module-header/multiline-with-comments-four-out.hs @@ -16,6 +16,7 @@ -- the second line bar3, module Foo.Bar.Baz, -) where +) +where -- Wow diff --git a/data/examples/module-header/named-section-four-out.hs b/data/examples/module-header/named-section-four-out.hs --- a/data/examples/module-header/named-section-four-out.hs +++ b/data/examples/module-header/named-section-four-out.hs @@ -5,7 +5,8 @@ -- ** Another level foo, bar, -) where +) +where {- $explanation diff --git a/data/examples/module-header/warning-pragma-list-multiline-four-out.hs b/data/examples/module-header/warning-pragma-list-multiline-four-out.hs --- a/data/examples/module-header/warning-pragma-list-multiline-four-out.hs +++ b/data/examples/module-header/warning-pragma-list-multiline-four-out.hs @@ -3,9 +3,9 @@ [ "This module is deprecated." , "Please use OtherModule instead." ] - #-} - ( + #-} ( foo, bar, baz, -) where +) +where diff --git a/data/examples/module-header/warning-pragma-singleton-list-four-out.hs b/data/examples/module-header/warning-pragma-singleton-list-four-out.hs --- a/data/examples/module-header/warning-pragma-singleton-list-four-out.hs +++ b/data/examples/module-header/warning-pragma-singleton-list-four-out.hs @@ -1,2 +1,1 @@ -module Test {-# WARNING "There's only one line here." #-} -where +module Test {-# WARNING "There's only one line here." #-} where diff --git a/data/examples/other/empty-haddock-four-out.hs b/data/examples/other/empty-haddock-four-out.hs --- a/data/examples/other/empty-haddock-four-out.hs +++ b/data/examples/other/empty-haddock-four-out.hs @@ -1,6 +1,7 @@ module Test ( test, -) where +) +where test :: test diff --git a/data/fourmolu/function-arrows/input.hs b/data/fourmolu/function-arrows/input.hs --- a/data/fourmolu/function-arrows/input.hs +++ b/data/fourmolu/function-arrows/input.hs @@ -1,4 +1,6 @@ {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LinearTypes #-} + module Main where -- | Something else. @@ -77,9 +79,50 @@ (c -> d) -> (a, b, c, d) +functionWithInterleavedCommentsTrailing :: + -- arg + Int -> + -- result + Bool + +functionWithInterleavedCommentsLeading + -- arg + :: Int + -- result + -> Bool + +multilineExprSig = do + bar + ( x :: + Int -> + Bool + ) + bar + ( x :: + -- arg + Int -> + -- result + Bool + ) + bar + ( x + -- arg + :: Int + -- result + -> Bool + ) + data Record = Record { recFun :: forall a. (C1, C2) => Int -> Int -> Bool , recOther :: Bool } + +foo :: + Int %1 -> + Bool +foo :: + forall x. + Int %Many -> + Bool diff --git a/data/fourmolu/function-arrows/output-LeadingArrows.hs b/data/fourmolu/function-arrows/output-LeadingArrows.hs --- a/data/fourmolu/function-arrows/output-LeadingArrows.hs +++ b/data/fourmolu/function-arrows/output-LeadingArrows.hs @@ -1,4 +1,5 @@ {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LinearTypes #-} module Main where @@ -77,7 +78,38 @@ ) -> (c -> d) -> (a, b, c, d) +functionWithInterleavedCommentsTrailing + -- arg + :: Int + -- result + -> Bool +functionWithInterleavedCommentsLeading + -- arg + :: Int + -- result + -> Bool +multilineExprSig = do + bar + ( x + :: Int + -> Bool + ) + bar + ( x + -- arg + :: Int + -- result + -> Bool + ) + bar + ( x + -- arg + :: Int + -- result + -> Bool + ) + data Record = Record { recFun :: forall a @@ -87,3 +119,11 @@ -> Bool , recOther :: Bool } + +foo + :: Int + %1 -> Bool +foo + :: forall x + . Int + %Many -> Bool diff --git a/data/fourmolu/function-arrows/output-TrailingArrows.hs b/data/fourmolu/function-arrows/output-TrailingArrows.hs --- a/data/fourmolu/function-arrows/output-TrailingArrows.hs +++ b/data/fourmolu/function-arrows/output-TrailingArrows.hs @@ -1,4 +1,5 @@ {-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE LinearTypes #-} module Main where @@ -77,7 +78,38 @@ ) -> (c -> d) -> (a, b, c, d) +functionWithInterleavedCommentsTrailing :: + -- arg + Int -> + -- result + Bool +functionWithInterleavedCommentsLeading :: + -- arg + Int -> + -- result + Bool +multilineExprSig = do + bar + ( x :: + Int -> + Bool + ) + bar + ( x :: + -- arg + Int -> + -- result + Bool + ) + bar + ( x :: + -- arg + Int -> + -- result + Bool + ) + data Record = Record { recFun :: forall a. @@ -87,3 +119,11 @@ Bool , recOther :: Bool } + +foo :: + Int %1 -> + Bool +foo :: + forall x. + Int %Many -> + Bool diff --git a/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs --- a/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs +++ b/data/fourmolu/import-export/output-ImportExportDiffFriendly.hs @@ -12,7 +12,8 @@ class1, class2 ), -) where +) +where import qualified MegaModule as M ( Either, diff --git a/data/fourmolu/let-style/input.hs b/data/fourmolu/let-style/input.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/input.hs @@ -0,0 +1,92 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=2.hs b/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=2.hs @@ -0,0 +1,92 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=4.hs b/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetAuto-InLeftAlign-indent=4.hs @@ -0,0 +1,92 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=2.hs b/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=2.hs @@ -0,0 +1,92 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=4.hs b/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetAuto-InRightAlign-indent=4.hs @@ -0,0 +1,92 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=2.hs b/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=2.hs @@ -0,0 +1,88 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let a = 1 + b = 2 + in a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=4.hs b/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetInline-InLeftAlign-indent=4.hs @@ -0,0 +1,88 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let a = 1 + b = 2 + in a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=2.hs b/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=2.hs @@ -0,0 +1,88 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let a = 1 + b = 2 + in a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=4.hs b/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetInline-InRightAlign-indent=4.hs @@ -0,0 +1,88 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let a :: Int + a = 1 + in a + 2 + +let_multi = + let a = 1 + b = 2 + in a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let a = 1 + b = 2 + in a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let b = 2 + c = 3 + + let d = "hello" + in print d + + let d = "hello" + e = "world" + in print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=2.hs b/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=2.hs @@ -0,0 +1,100 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let + b = 2 + c = 3 + + let d = "hello" + in print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=4.hs b/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetMixed-InLeftAlign-indent=4.hs @@ -0,0 +1,100 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let + b = 2 + c = 3 + + let d = "hello" + in print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=2.hs b/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=2.hs @@ -0,0 +1,100 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let + b = 2 + c = 3 + + let d = "hello" + in print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=4.hs b/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetMixed-InRightAlign-indent=4.hs @@ -0,0 +1,100 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let a = 1 + in a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let a = 1 + in a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let a = 1 + + let + b = 2 + c = 3 + + let d = "hello" + in print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + , let a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + , let a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=2.hs b/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=2.hs @@ -0,0 +1,113 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let + a = 1 + in + a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let + a = 1 + + let + b = 2 + c = 3 + + let + d = "hello" + in + print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=4.hs b/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetNewline-InLeftAlign-indent=4.hs @@ -0,0 +1,113 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let + a = 1 + in + a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let + a = 1 + + let + b = 2 + c = 3 + + let + d = "hello" + in + print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=2.hs b/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=2.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=2.hs @@ -0,0 +1,113 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let + a = 1 + in + a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let + a = 1 + + let + b = 2 + c = 3 + + let + d = "hello" + in + print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=4.hs b/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=4.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/let-style/output-LetNewline-InRightAlign-indent=4.hs @@ -0,0 +1,113 @@ +{-- should be the same in every option --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_oneline_empty = +-- let in 10 + +let_oneline_single = + let a = 1 in a + 2 + +let_oneline_multi = + let a = 1; b = 2 in a + b + +{-- pure let expressions --} + +-- TODO: https://github.com/tweag/ormolu/issues/917 +-- let_empty = +-- let +-- in 10 + +let_single = + let + a = 1 + in + a + 2 + +let_single_sig = + let + a :: Int + a = 1 + in + a + 2 + +let_multi = + let + a = 1 + b = 2 + in + a + b + +let_single_newline = + let + a = 1 + in + a + 2 + +let_multi_newline = + let + a = 1 + b = 2 + in + a + b + +{-- do-block --} + +test_do = do + -- TODO: https://github.com/tweag/ormolu/issues/917 + -- let + + let + a = 1 + + let + b = 2 + c = 3 + + let + d = "hello" + in + print d + + let + d = "hello" + e = "world" + in + print (d ++ e) + +{-- list comprehension --} + +test_list = + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 2 + ] + +test_list_do = do + x <- + [ x + a + b + c + | x <- xs + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] + + [ x + y + a + b + c + | y <- ys + , let + + , let + a = 1 + , let + b = 2 + c = 3 + ] diff --git a/data/fourmolu/respectful-module-where/input-multi.hs b/data/fourmolu/respectful-module-where/input-multi.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/input-multi.hs @@ -0,0 +1,63 @@ +module Foo where + +{- // -} + +module Foo +where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) +where + +{- // -} + +module Foo ( + a, + b, +) where + +{- // -} + +module Foo ( + a, + b, +) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} +where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} ( + a, + b, +) where + +{- // -} + +module Foo {-# WARNING "foo" #-} ( + a, + b, +) +where diff --git a/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportDiffFriendly.hs b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportDiffFriendly.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportDiffFriendly.hs @@ -0,0 +1,59 @@ +module Foo where + +{- // -} + +module Foo where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo ( + a, + b, +) where + +{- // -} + +module Foo ( + a, + b, +) where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} ( + a, + b, +) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} ( + a, + b, +) where diff --git a/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportLeading.hs b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportLeading.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportLeading.hs @@ -0,0 +1,63 @@ +module Foo where + +{- // -} + +module Foo where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo + ( a + , b + ) +where + +{- // -} + +module Foo + ( a + , b + ) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a + , b + ) +where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a + , b + ) +where diff --git a/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportTrailing.hs b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportTrailing.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=False-ImportExportTrailing.hs @@ -0,0 +1,63 @@ +module Foo where + +{- // -} + +module Foo where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo + ( a, + b, + ) +where + +{- // -} + +module Foo + ( a, + b, + ) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a, + b, + ) +where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a, + b, + ) +where diff --git a/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportDiffFriendly.hs b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportDiffFriendly.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportDiffFriendly.hs @@ -0,0 +1,65 @@ +module Foo where + +{- // -} + +module Foo +where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) +where + +{- // -} + +module Foo ( + a, + b, +) where + +{- // -} + +module Foo ( + a, + b, +) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} +where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) +where + +{- // -} + +module Foo + {-# WARNING "foo" #-} ( + a, + b, +) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} ( + a, + b, +) +where diff --git a/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportLeading.hs b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportLeading.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportLeading.hs @@ -0,0 +1,65 @@ +module Foo where + +{- // -} + +module Foo +where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) +where + +{- // -} + +module Foo + ( a + , b + ) where + +{- // -} + +module Foo + ( a + , b + ) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} +where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) +where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a + , b + ) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a + , b + ) +where diff --git a/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportTrailing.hs b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportTrailing.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/respectful-module-where/output-respectful=True-ImportExportTrailing.hs @@ -0,0 +1,65 @@ +module Foo where + +{- // -} + +module Foo +where + +{- // -} + +module Foo (a, b) where + +{- // -} + +module Foo (a, b) +where + +{- // -} + +module Foo + ( a, + b, + ) where + +{- // -} + +module Foo + ( a, + b, + ) +where + +{- // -} + +module Foo {-# WARNING "foo" #-} where + +{- // -} + +module Foo {-# WARNING "foo" #-} +where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) where + +{- // -} + +module Foo {-# WARNING "foo" #-} (a, b) +where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a, + b, + ) where + +{- // -} + +module Foo + {-# WARNING "foo" #-} + ( a, + b, + ) +where diff --git a/data/fourmolu/unicode-syntax/input.hs b/data/fourmolu/unicode-syntax/input.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/unicode-syntax/input.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UnicodeSyntax #-} + +module UnicodeExample where + +import Control.Arrow +import Data.Kind +import Language.Haskell.TH (Exp, Quote) +import Prelude hiding (elem) + +data T = MkT {foo :: Int} + +data Term a where + Lit :: Int -> Term Int + Succ :: Term Int -> Term Int + IsZero :: Term Int -> Term Bool + If :: Term Bool -> Term a -> Term a -> Term a + Pair :: Term a -> Term b -> Term (a, b) + +newtype Swizzle = MkSwizzle (forall a. Ord a => [a] -> [a]) + +data family GMap k :: Type -> Type + +data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + +type family F a where + F Int = Double + F Bool = Char + F a = String + +type family Id a = r | r -> a + +type instance Id Int = Int + +type instance Id Bool = Bool + +type family Elem c :: Type + +type instance Elem [e] = e + +data T1 a = MkT1 a + +construct :: a %1 -> T1 a +construct x = MkT1 x + +deconstruct :: T1 a %1 -> a +deconstruct (MkT1 x) = x + +pattern HeadC x <- x : xs + where + HeadC x = [x] + +pattern Point :: Int -> Int -> (Int, Int) +pattern Point {x, y} = (x, y) + +class (Monad m, Monad (t m)) => Transform t m where + lift :: m a -> (t m) a + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +instance (Eq a) => Eq (Tree a) where + Leaf a == Leaf b = a == b + (Branch l1 r1) == (Branch l2 r2) = (l1 == l2) && (r1 == r2) + _ == _ = False + +add1 :: Quote m => Int -> m Exp +add1 x = [|x + 1|] + +monad = do + putStr "x: " + l <- getLine + return (words l) + +arrow f g h = proc x -> do + y <- f -< x + 1 + g -< 2 * y + let z = x + y + t <- h -< x * z + returnA -< t + z + +elem :: (Eq a) => a -> [a] -> Bool +x `elem` [] = False +x `elem` (y : ys) = x == y || (x `elem` ys) + +h :: (forall a. a -> a) -> (Bool, Char) +h f = (f True, f 'c') diff --git a/data/fourmolu/unicode-syntax/output-UnicodeAlways.hs b/data/fourmolu/unicode-syntax/output-UnicodeAlways.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/unicode-syntax/output-UnicodeAlways.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UnicodeSyntax #-} + +module UnicodeExample where + +import Control.Arrow +import Data.Kind +import Language.Haskell.TH (Exp, Quote) +import Prelude hiding (elem) + +data T = MkT {foo ∷ Int} + +data Term a where + Lit ∷ Int → Term Int + Succ ∷ Term Int → Term Int + IsZero ∷ Term Int → Term Bool + If ∷ Term Bool → Term a → Term a → Term a + Pair ∷ Term a → Term b → Term (a, b) + +newtype Swizzle = MkSwizzle (∀ a. Ord a ⇒ [a] → [a]) + +data family GMap k ∷ Type → Type + +data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + +type family F a where + F Int = Double + F Bool = Char + F a = String + +type family Id a = r | r → a + +type instance Id Int = Int + +type instance Id Bool = Bool + +type family Elem c ∷ Type + +type instance Elem [e] = e + +data T1 a = MkT1 a + +construct ∷ a ⊸ T1 a +construct x = MkT1 x + +deconstruct ∷ T1 a ⊸ a +deconstruct (MkT1 x) = x + +pattern HeadC x ← x : xs + where + HeadC x = [x] + +pattern Point ∷ Int → Int → (Int, Int) +pattern Point{x, y} = (x, y) + +class (Monad m, Monad (t m)) ⇒ Transform t m where + lift ∷ m a → (t m) a + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +instance (Eq a) ⇒ Eq (Tree a) where + Leaf a == Leaf b = a == b + (Branch l1 r1) == (Branch l2 r2) = (l1 == l2) && (r1 == r2) + _ == _ = False + +add1 ∷ Quote m ⇒ Int → m Exp +add1 x = [|x + 1|] + +monad = do + putStr "x: " + l ← getLine + return (words l) + +arrow f g h = proc x → do + y ← f ⤙ x + 1 + g ⤙ 2 * y + let z = x + y + t ← h ⤙ x * z + returnA ⤙ t + z + +elem ∷ (Eq a) ⇒ a → [a] → Bool +x `elem` [] = False +x `elem` (y : ys) = x == y || (x `elem` ys) + +h ∷ (∀ a. a → a) → (Bool, Char) +h f = (f True, f 'c') diff --git a/data/fourmolu/unicode-syntax/output-UnicodeDetect.hs b/data/fourmolu/unicode-syntax/output-UnicodeDetect.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/unicode-syntax/output-UnicodeDetect.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UnicodeSyntax #-} + +module UnicodeExample where + +import Control.Arrow +import Data.Kind +import Language.Haskell.TH (Exp, Quote) +import Prelude hiding (elem) + +data T = MkT {foo ∷ Int} + +data Term a where + Lit ∷ Int → Term Int + Succ ∷ Term Int → Term Int + IsZero ∷ Term Int → Term Bool + If ∷ Term Bool → Term a → Term a → Term a + Pair ∷ Term a → Term b → Term (a, b) + +newtype Swizzle = MkSwizzle (∀ a. Ord a ⇒ [a] → [a]) + +data family GMap k ∷ Type → Type + +data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + +type family F a where + F Int = Double + F Bool = Char + F a = String + +type family Id a = r | r → a + +type instance Id Int = Int + +type instance Id Bool = Bool + +type family Elem c ∷ Type + +type instance Elem [e] = e + +data T1 a = MkT1 a + +construct ∷ a ⊸ T1 a +construct x = MkT1 x + +deconstruct ∷ T1 a ⊸ a +deconstruct (MkT1 x) = x + +pattern HeadC x ← x : xs + where + HeadC x = [x] + +pattern Point ∷ Int → Int → (Int, Int) +pattern Point{x, y} = (x, y) + +class (Monad m, Monad (t m)) ⇒ Transform t m where + lift ∷ m a → (t m) a + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +instance (Eq a) ⇒ Eq (Tree a) where + Leaf a == Leaf b = a == b + (Branch l1 r1) == (Branch l2 r2) = (l1 == l2) && (r1 == r2) + _ == _ = False + +add1 ∷ Quote m ⇒ Int → m Exp +add1 x = [|x + 1|] + +monad = do + putStr "x: " + l ← getLine + return (words l) + +arrow f g h = proc x → do + y ← f ⤙ x + 1 + g ⤙ 2 * y + let z = x + y + t ← h ⤙ x * z + returnA ⤙ t + z + +elem ∷ (Eq a) ⇒ a → [a] → Bool +x `elem` [] = False +x `elem` (y : ys) = x == y || (x `elem` ys) + +h ∷ (∀ a. a → a) → (Bool, Char) +h f = (f True, f 'c') diff --git a/data/fourmolu/unicode-syntax/output-UnicodeNever.hs b/data/fourmolu/unicode-syntax/output-UnicodeNever.hs new file mode 100644 --- /dev/null +++ b/data/fourmolu/unicode-syntax/output-UnicodeNever.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LinearTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE UnicodeSyntax #-} + +module UnicodeExample where + +import Control.Arrow +import Data.Kind +import Language.Haskell.TH (Exp, Quote) +import Prelude hiding (elem) + +data T = MkT {foo :: Int} + +data Term a where + Lit :: Int -> Term Int + Succ :: Term Int -> Term Int + IsZero :: Term Int -> Term Bool + If :: Term Bool -> Term a -> Term a -> Term a + Pair :: Term a -> Term b -> Term (a, b) + +newtype Swizzle = MkSwizzle (forall a. Ord a => [a] -> [a]) + +data family GMap k :: Type -> Type + +data instance GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) + +type family F a where + F Int = Double + F Bool = Char + F a = String + +type family Id a = r | r -> a + +type instance Id Int = Int + +type instance Id Bool = Bool + +type family Elem c :: Type + +type instance Elem [e] = e + +data T1 a = MkT1 a + +construct :: a %1 -> T1 a +construct x = MkT1 x + +deconstruct :: T1 a %1 -> a +deconstruct (MkT1 x) = x + +pattern HeadC x <- x : xs + where + HeadC x = [x] + +pattern Point :: Int -> Int -> (Int, Int) +pattern Point{x, y} = (x, y) + +class (Monad m, Monad (t m)) => Transform t m where + lift :: m a -> (t m) a + +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +instance (Eq a) => Eq (Tree a) where + Leaf a == Leaf b = a == b + (Branch l1 r1) == (Branch l2 r2) = (l1 == l2) && (r1 == r2) + _ == _ = False + +add1 :: Quote m => Int -> m Exp +add1 x = [|x + 1|] + +monad = do + putStr "x: " + l <- getLine + return (words l) + +arrow f g h = proc x -> do + y <- f -< x + 1 + g -< 2 * y + let z = x + y + t <- h -< x * z + returnA -< t + z + +elem :: (Eq a) => a -> [a] -> Bool +x `elem` [] = False +x `elem` (y : ys) = x == y || (x `elem` ys) + +h :: (forall a. a -> a) -> (Bool, Char) +h f = (f True, f 'c') diff --git a/fourmolu.cabal b/fourmolu.cabal --- a/fourmolu.cabal +++ b/fourmolu.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: fourmolu -version: 0.8.2.0 +version: 0.9.0.0 license: BSD-3-Clause license-file: LICENSE.md maintainer: diff --git a/fourmolu.yaml b/fourmolu.yaml --- a/fourmolu.yaml +++ b/fourmolu.yaml @@ -7,5 +7,8 @@ record-brace-space: true newlines-between-decls: 1 haddock-style: single-line +let-style: inline +in-style: right-align +unicode: never respectful: false fixities: [] diff --git a/src/Ormolu/Config.hs b/src/Ormolu/Config.hs --- a/src/Ormolu/Config.hs +++ b/src/Ormolu/Config.hs @@ -35,6 +35,8 @@ CommaStyle (..), HaddockPrintStyle (..), ImportExportStyle (..), + LetStyle (..), + InStyle (..), -- ** Loading Fourmolu configuration loadConfigFile, @@ -225,6 +227,9 @@ poRecordBraceSpace <- f poRecordBraceSpace0 poNewlinesBetweenDecls <- f poNewlinesBetweenDecls0 poHaddockStyle <- f poHaddockStyle0 + poLetStyle <- f poLetStyle0 + poInStyle <- f poInStyle0 + poUnicode <- f poUnicode0 poRespectful <- f poRespectful0 return PrinterOpts {..} @@ -339,6 +344,33 @@ (showAllValues haddockPrintStyleMap), metaDefault = HaddockMultiLine }, + poLetStyle = + PrinterOptsFieldMeta + { metaName = "let-style", + metaGetField = poLetStyle, + metaPlaceholder = "STYLE", + metaHelp = + printf + "Styling of let blocks (choices: %s)" + (showAllValues letStyleMap), + metaDefault = LetAuto + }, + poInStyle = + PrinterOptsFieldMeta + { metaName = "in-style", + metaGetField = poInStyle, + metaPlaceholder = "STYLE", + metaHelp = "How to align the 'in' keyword with respect to the 'let' keyword", + metaDefault = InRightAlign + }, + poUnicode = + PrinterOptsFieldMeta + { metaName = "unicode", + metaGetField = poUnicode, + metaPlaceholder = "UNICODE", + metaHelp = printf "Output Unicode syntax (choices: %s)" (showAllValues unicodePreferenceMap), + metaDefault = UnicodeNever + }, poRespectful = PrinterOptsFieldMeta { metaName = "respectful", @@ -408,6 +440,33 @@ ] ) +letStyleMap :: BijectiveMap LetStyle +letStyleMap = + $( mkBijectiveMap + [ ('LetAuto, "auto"), + ('LetInline, "inline"), + ('LetNewline, "newline"), + ('LetMixed, "mixed") + ] + ) + +inStyleMap :: BijectiveMap InStyle +inStyleMap = + $( mkBijectiveMap + [ ('InLeftAlign, "left-align"), + ('InRightAlign, "right-align") + ] + ) + +unicodePreferenceMap :: BijectiveMap Unicode +unicodePreferenceMap = + $( mkBijectiveMap + [ ('UnicodeDetect, "detect"), + ('UnicodeAlways, "always"), + ('UnicodeNever, "never") + ] + ) + instance PrinterOptsFieldType CommaStyle where parseJSON = parseJSONWith commaStyleMap "CommaStyle" parseText = parseTextWith commaStyleMap @@ -427,6 +486,21 @@ parseJSON = parseJSONWith importExportStyleMap "ImportExportStyle" parseText = parseTextWith importExportStyleMap showText = show . showTextWith importExportStyleMap + +instance PrinterOptsFieldType LetStyle where + parseJSON = parseJSONWith letStyleMap "LetStyle" + parseText = parseTextWith letStyleMap + showText = show . showTextWith letStyleMap + +instance PrinterOptsFieldType InStyle where + parseJSON = parseJSONWith inStyleMap "InStyle" + parseText = parseTextWith inStyleMap + showText = show . showTextWith inStyleMap + +instance PrinterOptsFieldType Unicode where + parseJSON = parseJSONWith unicodePreferenceMap "UnicodePreference" + parseText = parseTextWith unicodePreferenceMap + showText = show . showTextWith unicodePreferenceMap ---------------------------------------------------------------------------- -- BijectiveMap helpers diff --git a/src/Ormolu/Config/Types.hs b/src/Ormolu/Config/Types.hs --- a/src/Ormolu/Config/Types.hs +++ b/src/Ormolu/Config/Types.hs @@ -7,6 +7,9 @@ FunctionArrowsStyle (..), HaddockPrintStyle (..), ImportExportStyle (..), + LetStyle (..), + InStyle (..), + Unicode (..), ) where @@ -30,6 +33,12 @@ poNewlinesBetweenDecls :: f Int, -- | How to print doc comments poHaddockStyle :: f HaddockPrintStyle, + -- | Styling of let blocks + poLetStyle :: f LetStyle, + -- | How to align in keyword + poInStyle :: f InStyle, + -- | Output Unicode syntax + poUnicode :: f Unicode, -- | Be less opinionated about spaces/newlines etc. poRespectful :: f Bool } @@ -55,4 +64,22 @@ = ImportExportLeading | ImportExportTrailing | ImportExportDiffFriendly + deriving (Eq, Show, Enum, Bounded) + +data LetStyle + = LetAuto + | LetInline + | LetNewline + | LetMixed + deriving (Eq, Show, Enum, Bounded) + +data InStyle + = InLeftAlign + | InRightAlign + deriving (Eq, Show, Enum, Bounded) + +data Unicode + = UnicodeDetect + | UnicodeAlways + | UnicodeNever deriving (Eq, Show, Enum, Bounded) diff --git a/src/Ormolu/Exception.hs b/src/Ormolu/Exception.hs --- a/src/Ormolu/Exception.hs +++ b/src/Ormolu/Exception.hs @@ -4,6 +4,7 @@ -- | 'OrmoluException' type and surrounding definitions. module Ormolu.Exception ( OrmoluException (..), + printOrmoluException, withPrettyOrmoluExceptions, ) where diff --git a/src/Ormolu/Printer/Combinators.hs b/src/Ormolu/Printer/Combinators.hs --- a/src/Ormolu/Printer/Combinators.hs +++ b/src/Ormolu/Printer/Combinators.hs @@ -29,7 +29,6 @@ askSourceType, askFixityOverrides, askFixityMap, - inciByExact, located, located', switchLayout, @@ -39,6 +38,7 @@ breakpoint, breakpoint', getPrinterOpt, + whenUnicodeOtherwise, -- ** Formatting lists sep, @@ -64,6 +64,21 @@ commaDel, commaDelImportExport, equals, + llarrowtail, + rrarrowtail, + darrow, + dcolon, + larrow, + larrowtail, + rarrow, + rarrowtail, + star, + forall, + oparenbar, + cparenbar, + openExpQuote, + closeQuote, + lolly, -- ** Stateful markers SpanMark (..), @@ -75,19 +90,16 @@ -- ** Placement Placement (..), placeHanging, - - -- ** Helpers for leading/trailing arrows - leadingArrowType, - trailingArrowType, ) where import Control.Monad import Data.List (intersperse) import Data.Text (Text) +import GHC.LanguageExtensions.Type import GHC.Types.SrcLoc import Ormolu.Config -import Ormolu.Config.Types (FunctionArrowsStyle (..)) +import Ormolu.Config.Types import Ormolu.Printer.Comments import Ormolu.Printer.Internal import Ormolu.Utils (HasSrcSpan (..)) @@ -171,6 +183,17 @@ breakpoint' :: R () breakpoint' = vlayout (return ()) newline +-- | Write the one text or the other depending on whether Unicode is enabled. +whenUnicodeOtherwise :: Text -> Text -> R () +unicodeText `whenUnicodeOtherwise` asciiText = do + unicodePrinterOption <- getPrinterOpt poUnicode + unicodeExtensionIsEnabled <- isExtensionEnabled UnicodeSyntax + txt $ case unicodePrinterOption of + UnicodeDetect | unicodeExtensionIsEnabled -> unicodeText + UnicodeDetect | otherwise -> asciiText + UnicodeAlways -> unicodeText + UnicodeNever -> asciiText + ---------------------------------------------------------------------------- -- Formatting lists @@ -342,6 +365,71 @@ equals :: R () equals = interferingTxt "=" +-- The names of the following literals are from GHC's +-- @compiler/GHC/Parser/Lexer.x@. + +llarrowtail, + rrarrowtail, + darrow, + dcolon, + larrow, + larrowtail, + rarrow, + rarrowtail, + star, + forall, + oparenbar, + cparenbar, + openExpQuote, + closeQuote, + lolly :: + R () + +-- | Print @⤛@ or @-<<@ as appropriate. +llarrowtail = "⤛" `whenUnicodeOtherwise` "-<<" + +-- | Print @⤜@ or @>>-@ as appropriate. +rrarrowtail = "⤜" `whenUnicodeOtherwise` ">>-" + +-- | Print @⇒@ or @=>@ as appropriate. +darrow = "⇒" `whenUnicodeOtherwise` "=>" + +-- | Print @∷@ or @::@ as appropriate. +dcolon = "∷" `whenUnicodeOtherwise` "::" + +-- | Print @←@ or @<-@ as appropriate. +larrow = "←" `whenUnicodeOtherwise` "<-" + +-- | Print @⤙@ or @-<@ as appropriate. +larrowtail = "⤙" `whenUnicodeOtherwise` "-<" + +-- | Print @→@ or @->@ as appropriate. +rarrow = "→" `whenUnicodeOtherwise` "->" + +-- | Print @⤚@ or @>-@ as appropriate. +rarrowtail = "⤚" `whenUnicodeOtherwise` ">-" + +-- | Print @★@ or @*@ as appropriate. +star = "★" `whenUnicodeOtherwise` "*" + +-- | Print @∀@ or @forall@ as appropriate. +forall = "∀" `whenUnicodeOtherwise` "forall" + +-- | Print @⦇@ or @(|@ as appropriate. +oparenbar = "⦇" `whenUnicodeOtherwise` "(|" + +-- | Print @⦈@ or @|)@ as appropriate. +cparenbar = "⦈" `whenUnicodeOtherwise` "|)" + +-- | Print @⟦@ or @[|@ as appropriate. +openExpQuote = "⟦" `whenUnicodeOtherwise` "[|" + +-- | Print @⟧@ or @|]@ as appropriate. +closeQuote = "⟧" `whenUnicodeOtherwise` "|]" + +-- | Print @⊸@ or @%1 ->@ as appropriate. +lolly = "⊸" `whenUnicodeOtherwise` "%1 ->" + ---------------------------------------------------------------------------- -- Placement @@ -370,24 +458,3 @@ Normal -> do breakpoint inci m - ----------------------------------------------------------------------------- --- Arrow style - --- | Output @space >> txt "::"@ when we are printing with trailing arrows -trailingArrowType :: R () -trailingArrowType = - getPrinterOpt poFunctionArrows >>= \case - TrailingArrows -> do - space - txt "::" - LeadingArrows -> pure () - --- | Output @txt "::" >> space@ when we are printing with leading arrows -leadingArrowType :: R () -leadingArrowType = - getPrinterOpt poFunctionArrows >>= \case - LeadingArrows -> do - txt "::" - space - TrailingArrows -> pure () diff --git a/src/Ormolu/Printer/Internal.hs b/src/Ormolu/Printer/Internal.hs --- a/src/Ormolu/Printer/Internal.hs +++ b/src/Ormolu/Printer/Internal.hs @@ -26,7 +26,6 @@ inciBy, inciByFrac, inciHalf, - inciByExact, sitcc, sitccIfTrailing, Layout (..), @@ -59,9 +58,6 @@ -- * Extensions isExtensionEnabled, - PrevTypeCtx (..), - getPrevTypeCtx, - setPrevTypeCtx, ) where @@ -139,9 +135,7 @@ -- | Whether to output a space before the next output scRequestedDelimiter :: !RequestedDelimiter, -- | An auxiliary marker for keeping track of last output element - scSpanMark :: !(Maybe SpanMark), - -- | What (if any) precedes the current type on the same line - scPrevTypeCtx :: PrevTypeCtx + scSpanMark :: !(Maybe SpanMark) } -- | Make sure next output is delimited by one of the following. @@ -218,8 +212,7 @@ scCommentStream = cstream, scPendingComments = [], scRequestedDelimiter = VeryBeginning, - scSpanMark = Nothing, - scPrevTypeCtx = TypeCtxStart + scSpanMark = Nothing } ---------------------------------------------------------------------------- @@ -450,15 +443,6 @@ inciHalf :: R () -> R () inciHalf = inciByFrac 2 --- | Like 'inci', but indents by exactly the given number of spaces. -inciByExact :: Int -> R () -> R () -inciByExact spaces (R m) = R (local modRC m) - where - modRC rc = - rc - { rcIndent = rcIndent rc + spaces - } - -- | 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. @@ -654,22 +638,3 @@ isExtensionEnabled :: Extension -> R Bool isExtensionEnabled ext = R . asks $ EnumSet.member ext . rcExtensions - ----------------------------------------------------------------------------- --- Previous type context - --- | What (if anything) precedes the current type on the same line --- Only used for the `function-arrows` setting -data PrevTypeCtx - = TypeCtxStart - | TypeCtxForall - | TypeCtxContext - | TypeCtxArgument - deriving (Eq, Show) - -getPrevTypeCtx :: R PrevTypeCtx -getPrevTypeCtx = R (gets scPrevTypeCtx) - -setPrevTypeCtx :: PrevTypeCtx -> R () -setPrevTypeCtx prevTypeCtx = - R $ modify (\sc -> sc {scPrevTypeCtx = prevTypeCtx}) diff --git a/src/Ormolu/Printer/Meat/Declaration/Class.hs b/src/Ormolu/Printer/Meat/Declaration/Class.hs --- a/src/Ormolu/Printer/Meat/Declaration/Class.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Class.hs @@ -78,7 +78,7 @@ p_classContext ctx = unless (null (unLoc ctx)) $ do located ctx p_hsContext space - txt "=>" + darrow breakpoint p_classFundeps :: [LHsFunDep GhcPs] -> R () @@ -97,7 +97,7 @@ p_funDep (FunDep _ before after) = do sep space p_rdrName before space - txt "->" + rarrow space sep space p_rdrName after diff --git a/src/Ormolu/Printer/Meat/Declaration/Data.hs b/src/Ormolu/Printer/Meat/Declaration/Data.hs --- a/src/Ormolu/Printer/Meat/Declaration/Data.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Data.hs @@ -66,7 +66,7 @@ (p_lhsTypeArg <$> tpats) forM_ dd_kindSig $ \k -> do space - txt "::" + dcolon breakpoint inci $ located k p_hsType let gadt = isJust dd_kindSig || any (isGadt . unLoc) dd_cons @@ -126,13 +126,6 @@ commaDel sep commaDel p_rdrName cs inci $ do - trailingArrowType - let interArgBreak = - if hasDocStrings (unLoc con_res_ty) - then newline - else breakpoint - interArgBreak - leadingArrowType let conTy = case con_g_args of PrefixConGADT xs -> let go (HsScaled a b) t = addCLocAA t b (HsFunTy EpAnnNotUsed a b t) @@ -152,7 +145,7 @@ quantifiedTy = addCLocAA con_bndrs qualTy $ hsOuterTyVarBndrsToHsType (unLoc con_bndrs) qualTy - p_hsType (unLoc quantifiedTy) + startTypeAnnotationDecl quantifiedTy id p_hsType ConDeclH98 {..} -> do mapM_ (p_hsDocString Pipe True) con_doc let conDeclWithContextSpn = @@ -200,7 +193,7 @@ ctx -> do located ctx p_hsContext space - txt "=>" + darrow breakpoint isGadt :: ConDecl GhcPs -> Bool diff --git a/src/Ormolu/Printer/Meat/Declaration/Signature.hs b/src/Ormolu/Printer/Meat/Declaration/Signature.hs --- a/src/Ormolu/Printer/Meat/Declaration/Signature.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Signature.hs @@ -59,13 +59,8 @@ p_typeAscription :: LHsSigType GhcPs -> R () -p_typeAscription sigType = inci $ do - trailingArrowType - if hasDocStrings (unLoc . sig_body . unLoc $ sigType) - then newline - else breakpoint - leadingArrowType - located sigType p_hsSigType +p_typeAscription lsigType = + inci $ startTypeAnnotationDecl lsigType (unLoc . sig_body) p_hsSigType p_patSynSig :: [LocatedN RdrName] -> @@ -137,11 +132,10 @@ p_activation inl_act space p_rdrName name - trailingArrowType - inci $ do - leadingArrowType - breakpoint - sep commaDel (located' p_hsSigType) ts + space + dcolon + breakpoint + inci $ sep commaDel (located' p_hsSigType) ts p_inlineSpec :: InlineSpec -> R () p_inlineSpec = \case @@ -208,9 +202,9 @@ pragma "COMPLETE" . inci $ do sep commaDel p_rdrName cs forM_ mty $ \ty -> do - trailingArrowType + space + dcolon breakpoint - leadingArrowType inci (p_rdrName ty) p_sccSig :: LocatedN RdrName -> Maybe (Located StringLiteral) -> R () @@ -226,7 +220,4 @@ inci $ do space p_rdrName name - trailingArrowType - breakpoint - leadingArrowType - located sigTy p_hsSigType + startTypeAnnotation sigTy p_hsSigType diff --git a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs --- a/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs +++ b/src/Ormolu/Printer/Meat/Declaration/TypeFamily.hs @@ -63,10 +63,7 @@ p_familyResultSigL (L _ a) = case a of NoSig NoExtField -> Nothing KindSig NoExtField k -> Just $ do - trailingArrowType - breakpoint - leadingArrowType - located k p_hsType + startTypeAnnotation k p_hsType TyVarSig NoExtField bndr -> Just $ do equals breakpoint @@ -78,7 +75,7 @@ space p_rdrName a space - txt "->" + rarrow space sep space p_rdrName bs diff --git a/src/Ormolu/Printer/Meat/Declaration/Value.hs b/src/Ormolu/Printer/Meat/Declaration/Value.hs --- a/src/Ormolu/Printer/Meat/Declaration/Value.hs +++ b/src/Ormolu/Printer/Meat/Declaration/Value.hs @@ -26,7 +26,7 @@ import Data.Function (on) import Data.Functor ((<&>)) import Data.Generics.Schemes (everything) -import Data.List (intersperse, sortBy) +import Data.List (find, intersperse, sortBy) import Data.List.NonEmpty (NonEmpty (..), (<|)) import qualified Data.List.NonEmpty as NE import Data.Maybe @@ -273,7 +273,7 @@ Function _ -> space >> inci equals PatternBind -> space >> inci equals s | isCase s && hasGuards -> return () - _ -> space >> txt "->" + _ -> space >> rarrow switchLayout [patGrhssSpan] $ placeHanging placement p_body inci p_where @@ -301,7 +301,7 @@ space inci $ case style of EqualSign -> equals - RightArrow -> txt "->" + RightArrow -> rarrow -- If we have a sequence of guards and it is placed in the normal way, -- then we indent one level more for readability. Otherwise (all -- guards are on the same line) we do not need to indent, as it would @@ -333,10 +333,10 @@ breakpoint inci $ do case (arrType, rightToLeft) of - (HsFirstOrderApp, True) -> txt "-<" - (HsHigherOrderApp, True) -> txt "-<<" - (HsFirstOrderApp, False) -> txt ">-" - (HsHigherOrderApp, False) -> txt ">>-" + (HsFirstOrderApp, True) -> larrowtail + (HsHigherOrderApp, True) -> llarrowtail + (HsFirstOrderApp, False) -> rarrowtail + (HsHigherOrderApp, False) -> rrarrowtail placeHanging (exprPlacement (unLoc input)) $ located r p_hsExpr HsCmdArrForm _ form Prefix _ cmds -> banana s $ do @@ -364,8 +364,8 @@ p_lamcase cmdPlacement p_hsCmd mgroup HsCmdIf _ _ if' then' else' -> p_if cmdPlacement p_hsCmd if' then' else' - HsCmdLet _ localBinds c -> - p_let p_hsCmd localBinds c + HsCmdLet epAnnLet localBinds c -> + p_let (s == S) p_hsCmd epAnnLet localBinds c HsCmdDo _ es -> do txt "do" p_stmts cmdPlacement (p_hsCmd' S) es @@ -422,7 +422,7 @@ BindStmt _ p f@(getLocA -> l) -> do located p p_pat space - txt "<-" + larrow let loc = getLocA p placement | isOneLineSpan (mkSrcSpan (srcSpanEnd loc) (srcSpanStart l)) = placer (unLoc f) @@ -431,10 +431,13 @@ placeHanging placement (located f render) ApplicativeStmt {} -> notImplemented "ApplicativeStmt" -- generated by renamer BodyStmt _ body _ _ -> located body render - LetStmt _ binds -> do - txt "let" - space - sitcc $ p_hsLocalBinds binds + LetStmt epAnnLet binds -> do + let letLoc = + fmap (\(AddEpAnn _ loc) -> loc) + . find (\(AddEpAnn ann _) -> ann == AnnLet) + . epAnnAnns + $ epAnnLet + p_let' True letLoc binds Nothing ParStmt {} -> -- 'ParStmt' should always be eliminated in 'gatherStmt' already, such -- that it never occurs in 'p_stmt''. Consequently, handling it here @@ -744,8 +747,8 @@ txt "if" breakpoint inci . inci $ sep newline (located' (p_grhs RightArrow)) guards - HsLet _ localBinds e -> - p_let p_hsExpr localBinds e + HsLet epAnnLet localBinds e -> + p_let (s == S) p_hsExpr epAnnLet localBinds e HsDo _ ctx es -> do let doBody moduleName header = do forM_ moduleName $ \m -> atom m *> txt "." @@ -817,10 +820,7 @@ p_fieldLabels (NE.toList proj_flds) ExprWithTySig _ x HsWC {hswc_body} -> sitcc $ do located x p_hsExpr - trailingArrowType - breakpoint - leadingArrowType - inci $ located hswc_body p_hsSigType + inci $ startTypeAnnotation hswc_body p_hsSigType ArithSeq _ _ x -> case x of From from -> brackets s $ do @@ -853,7 +853,7 @@ breakpoint inci (p_pat x) breakpoint - txt "->" + rarrow placeHanging (cmdTopPlacement (unLoc e)) $ located e (p_hsCmdTop N) HsStatic _ e -> do @@ -878,7 +878,7 @@ case psb_dir of Unidirectional -> switchLayout pattern_def_spans $ do - txt "<-" + larrow breakpoint located psb_def p_pat ImplicitBidirectional -> @@ -888,7 +888,7 @@ located psb_def p_pat ExplicitBidirectional mgroup -> do switchLayout pattern_def_spans $ do - txt "<-" + larrow breakpoint located psb_def p_pat breakpoint @@ -996,20 +996,98 @@ placeHanging (placer x) (render x) p_let :: + -- | True if in do-block + Bool -> -- | Render (body -> R ()) -> + -- | Annotation for the `let` block + EpAnn AnnsLet -> HsLocalBinds GhcPs -> LocatedA body -> R () -p_let render localBinds e = sitcc $ do - txt "let" - space - dontUseBraces $ sitcc (p_hsLocalBinds localBinds) - vlayout space (newline >> txt " ") - txt "in" - space - sitcc (located e render) +p_let inDo render epAnnLet localBinds e = p_let' inDo letLoc localBinds $ Just (located e render) + where + letLoc = + case epAnnLet of + EpAnn {anns} -> Just (alLet anns) + EpAnnNotUsed -> Nothing +p_let' :: + -- | True if in do-block + Bool -> + -- | Annotation for the `let` block + Maybe EpaLocation -> + -- | Let bindings + HsLocalBinds GhcPs -> + -- | Optional 'in' body + Maybe (R ()) -> + R () +p_let' inDo letLoc localBinds mBody = do + letStyle <- getPrinterOpt poLetStyle + inStyle <- getPrinterOpt poInStyle + layout <- getLayout + -- isAllInline = True if whole "let ... in ..." is one line + let isAllInline = not inDo && layout == SingleLine + -- isBlockInline = True if each "let ..." + "in ..." block is one line + let isBlockInline = + case letStyle of + _ | isAllInline -> True + LetAuto -> + -- check if local binds are on the same line as the "let" keyword; + -- if we can't figure out the positions, just fallback to `inline` style + fromMaybe True $ do + letStartLine <- srcSpanStartLine . epaLocationRealSrcSpan <$> letLoc + localBindsStartLine <- localBindsEpAnns localBinds >>= epAnnsStartLine + pure $ + -- special case when let has zero local binds + if localBindsStartLine == -1 + then True + else letStartLine == localBindsStartLine + LetInline -> True + LetNewline -> False + LetMixed -> numLocalBinds <= 1 + -- isInShifted = True if "in" is right-aligned with "let" + let isInShifted = inDo || inStyle == InRightAlign + + -- helpers + let block keyword body = do + txt keyword + if isBlockInline + then space >> sitcc body + else newline >> inci body + + sitcc $ do + block "let" (p_hsLocalBinds localBinds) + + case mBody of + Just body + | isAllInline -> do + space + block "in" body + | otherwise -> do + newline + let in_ + | isInShifted = " in" + | isBlockInline = "in " + | otherwise = "in" + block in_ body + Nothing -> pure () + where + numLocalBinds = + case localBinds of + HsValBinds _ (ValBinds _ binds sigs) -> length binds + length sigs + HsValBinds _ (XValBindsLR (NValBinds binds sigs)) -> length binds + length sigs + HsIPBinds _ (IPBinds _ binds) -> length binds + EmptyLocalBinds _ -> 0 + + localBindsEpAnns = \case + HsValBinds epanns _ -> Just epanns + HsIPBinds epanns _ -> Just epanns + EmptyLocalBinds _ -> Nothing + epAnnsStartLine = \case + EpAnn {entry} -> Just (srcSpanStartLine . anchor $ entry) + EpAnnNotUsed -> Nothing + p_pat :: Pat GhcPs -> R () p_pat = \case WildPat _ -> txt "_" @@ -1066,7 +1144,7 @@ ViewPat _ expr pat -> sitcc $ do located expr p_hsExpr space - txt "->" + rarrow breakpoint inci (located pat p_pat) SplicePat _ splice -> p_hsSplice splice diff --git a/src/Ormolu/Printer/Meat/ImportExport.hs b/src/Ormolu/Printer/Meat/ImportExport.hs --- a/src/Ormolu/Printer/Meat/ImportExport.hs +++ b/src/Ormolu/Printer/Meat/ImportExport.hs @@ -6,7 +6,6 @@ module Ormolu.Printer.Meat.ImportExport ( p_hsmodExports, p_hsmodImport, - breakIfNotDiffFriendly, ) where diff --git a/src/Ormolu/Printer/Meat/Module.hs b/src/Ormolu/Printer/Meat/Module.hs --- a/src/Ormolu/Printer/Meat/Module.hs +++ b/src/Ormolu/Printer/Meat/Module.hs @@ -11,6 +11,8 @@ import Control.Monad import GHC.Hs hiding (comment) import GHC.Types.SrcLoc +import GHC.Unit.Module.Name +import GHC.Utils.Outputable (ppr, showSDocUnsafe) import Ormolu.Config import Ormolu.Imports (normalizeImports) import Ormolu.Parser.CommentStream @@ -33,7 +35,7 @@ -- | AST to print HsModule -> R () -p_hsModule mstackHeader pragmas HsModule {..} = do +p_hsModule mstackHeader pragmas hsmod@HsModule {..} = do let deprecSpan = maybe [] (pure . getLocA) hsmodDeprecMessage exportSpans = maybe [] (pure . getLocA) hsmodExports switchLayout (deprecSpan <> exportSpans) $ do @@ -43,29 +45,7 @@ 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 - forM_ hsmodDeprecMessage $ \w -> do - breakpoint - located' p_moduleWarning w - breakIfNotDiffFriendly - - -- This works around an awkward idempotency bug with deprecation messages. - diffFriendly <- (==) ImportExportDiffFriendly <$> getPrinterOpt poImportExportStyle - when (diffFriendly && not (null hsmodDeprecMessage)) newline - - case hsmodExports of - Nothing -> return () - Just l -> do - located l $ \exports -> do - inci (p_hsmodExports exports) - breakIfNotDiffFriendly - txt "where" - newline + mapM_ (p_hsModuleHeader hsmod) hsmodName newline preserveGroups <- getPrinterOpt poRespectful forM_ (normalizeImports preserveGroups hsmodImports) $ \importGroup -> do @@ -77,3 +57,49 @@ (if preserveSpacing then p_hsDeclsRespectGrouping else p_hsDecls) Free hsmodDecls newline spitRemainingComments + +p_hsModuleHeader :: HsModule -> LocatedA ModuleName -> R () +p_hsModuleHeader HsModule {..} moduleName = do + located moduleName $ \name -> do + forM_ hsmodHaddockModHeader (p_hsDocString Pipe True) + p_hsmodName name + + forM_ hsmodDeprecMessage $ \w -> do + breakpoint + located' p_moduleWarning w + + isRespectful <- getPrinterOpt poRespectful + isDiffFriendly <- (== ImportExportDiffFriendly) <$> getPrinterOpt poImportExportStyle + let breakpointBeforeExportList = + case (hsmodDeprecMessage, hsmodExports) of + _ | not isDiffFriendly -> breakpoint + (Nothing, _) -> space + (Just _, Just exports) | (not . isOneLineSpan) (getLocA exports) -> space + _ -> breakpoint + breakpointBeforeWhere + | not isRespectful = breakpointBeforeExportList + | isOnSameLine moduleKeyword whereKeyword = space + | Just closeParen <- exportClosePSpan, isOnSameLine closeParen whereKeyword = space + | otherwise = newline + + case hsmodExports of + Nothing -> return () + Just l -> do + breakpointBeforeExportList + located l $ \exports -> do + inci (p_hsmodExports exports) + + breakpointBeforeWhere + txt "where" + newline + where + (moduleKeyword, whereKeyword) = + case am_main (anns hsmodAnn) of + -- [AnnModule, AnnWhere] or [AnnSignature, AnnWhere] + [AddEpAnn _ moduleLoc, AddEpAnn AnnWhere whereLoc] -> + (epaLocationRealSrcSpan moduleLoc, epaLocationRealSrcSpan whereLoc) + anns -> error $ "Module had unexpected annotations: " ++ showSDocUnsafe (ppr anns) + exportClosePSpan = do + AddEpAnn AnnCloseP loc <- al_close . anns . ann . getLoc =<< hsmodExports + Just $ epaLocationRealSrcSpan loc + isOnSameLine token1 token2 = srcSpanEndLine token1 == srcSpanStartLine token2 diff --git a/src/Ormolu/Printer/Meat/Type.hs b/src/Ormolu/Printer/Meat/Type.hs --- a/src/Ormolu/Printer/Meat/Type.hs +++ b/src/Ormolu/Printer/Meat/Type.hs @@ -8,6 +8,8 @@ module Ormolu.Printer.Meat.Type ( p_hsType, p_hsTypePostDoc, + startTypeAnnotation, + startTypeAnnotationDecl, hasDocStrings, p_hsContext, p_hsTyVarBndr, @@ -23,7 +25,6 @@ where import Control.Monad -import Data.Bool (bool) import Data.Foldable (for_) import GHC.Hs import GHC.Types.Basic hiding (isPromoted) @@ -33,24 +34,12 @@ import Ormolu.Config import Ormolu.Config.Types (FunctionArrowsStyle (..)) import Ormolu.Printer.Combinators -import Ormolu.Printer.Internal (PrevTypeCtx (..), enterLayout, getPrevTypeCtx, setPrevTypeCtx) import Ormolu.Printer.Meat.Common import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.OpTree (p_tyOpTree, tyOpTree) import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration.Value (p_hsSplice, p_stringLit) import Ormolu.Printer.Operators import Ormolu.Utils --- | Render an "PrevTypeCtx" infix -p_after :: Bool -> R () -p_after multilineArgs = - getPrevTypeCtx >>= \case - TypeCtxStart -> pure () - TypeCtxForall | multilineArgs -> txt " ." >> space - TypeCtxForall -> txt "." >> space - TypeCtxContext -> txt "=>" >> space - TypeCtxArgument -> txt "->" >> space - --- | Like 'p_hsType' but indent properly following a forall p_hsType :: HsType GhcPs -> R () p_hsType t = do s <- @@ -71,28 +60,20 @@ p_hsType' :: Bool -> TypeDocStyle -> HsType GhcPs -> R () p_hsType' multilineArgs docStyle = \case HsForAllTy _ tele t -> do - case tele of - HsForAllInvis _ bndrs -> p_forallBndrs' ForAllInvis p_hsTyVarBndr bndrs - HsForAllVis _ bndrs -> p_forallBndrs' ForAllVis p_hsTyVarBndr bndrs + vis <- + case tele of + HsForAllInvis _ bndrs -> p_forallBndrsStart p_hsTyVarBndr bndrs >> pure ForAllInvis + HsForAllVis _ bndrs -> p_forallBndrsStart p_hsTyVarBndr bndrs >> pure ForAllVis getPrinterOpt poFunctionArrows >>= \case - LeadingArrows | multilineArgs -> pure () - _ -> p_after False >> setPrevTypeCtx TypeCtxStart - interArgBreak + LeadingArrows | multilineArgs -> interArgBreak >> txt " " >> p_forallBndrsEnd vis + _ -> p_forallBndrsEnd vis >> interArgBreak p_hsTypeR (unLoc t) HsQualTy _ qs' t -> do - getPrinterOpt poFunctionArrows >>= \case - LeadingArrows -> do - after <- getPrevTypeCtx - bool id (inciByExact 3) (after == TypeCtxForall) $ for_ qs' $ \qs -> do - located qs p_hsContext - interArgBreak - TrailingArrows -> do - for_ qs' $ \qs -> do - located qs p_hsContext - space - txt "=>" - interArgBreak - setPrevTypeCtx TypeCtxContext + for_ qs' $ \qs -> do + located qs p_hsContext + getPrinterOpt poFunctionArrows >>= \case + LeadingArrows -> interArgBreak >> darrow >> space + TrailingArrows -> space >> darrow >> interArgBreak case unLoc t of HsQualTy {} -> p_hsTypeR (unLoc t) HsFunTy {} -> p_hsTypeR (unLoc t) @@ -100,7 +81,6 @@ HsTyVar _ p n -> do case p of IsPromoted -> do - space txt "'" case showOutputable (unLoc n) of _ : '\'' : _ -> space @@ -130,32 +110,20 @@ inci $ do txt "@" located kd p_hsType - HsFunTy _ arrow x y@(L _ y') -> do + HsFunTy _ arrow x y -> do + let p_arrow = + case arrow of + HsUnrestrictedArrow _ -> rarrow + HsLinearArrow _ _ -> lolly + HsExplicitMult _ _ mult -> do + txt "%" + p_hsTypeR (unLoc mult) + space + rarrow + located x p_hsType getPrinterOpt poFunctionArrows >>= \case - LeadingArrows -> do - after <- getPrevTypeCtx - bool id (inciByExact 3) (after == TypeCtxForall) (located x p_hsType) - interArgBreak - TrailingArrows -> do - located x p_hsType - space - case arrow of - HsUnrestrictedArrow _ -> txt "->" - HsLinearArrow _ _ -> txt "%1 ->" - HsExplicitMult _ _ mult -> do - txt "%" - setPrevTypeCtx TypeCtxContext - p_hsTypeR (unLoc mult) - space - txt "->" - interArgBreak - setPrevTypeCtx TypeCtxArgument - case y' of - HsFunTy {} -> do - layout <- getLayout - -- Render the comments properly, but keep the existing layout - located y (enterLayout layout . p_hsTypeR) - _ -> located y p_hsTypeR + LeadingArrows -> interArgBreak >> located y (\y' -> p_arrow >> space >> p_hsTypeR y') + TrailingArrows -> space >> p_arrow >> interArgBreak >> located y p_hsTypeR HsListTy _ t -> located t (brackets N . p_hsType) HsTupleTy _ tsort xs -> @@ -177,17 +145,11 @@ parens N $ sitcc $ located t p_hsType HsIParamTy _ n t -> sitcc $ do located n atom - trailingArrowType - breakpoint - leadingArrowType - inci (located t p_hsType) - HsStarTy _ _ -> txt "*" + inci $ startTypeAnnotation t p_hsType + HsStarTy _ _ -> star HsKindSig _ t k -> sitcc $ do located t p_hsType - trailingArrowType - breakpoint - leadingArrowType - inci (located k p_hsType) + inci $ startTypeAnnotation k p_hsType HsSpliceTy _ splice -> p_hsSplice splice HsDocTy _ t str -> case docStyle of @@ -245,12 +207,51 @@ if multilineArgs then newline else breakpoint - p_hsTypeR m = do - getPrinterOpt poFunctionArrows >>= \case - TrailingArrows -> pure () - LeadingArrows -> p_after multilineArgs - p_hsType' multilineArgs docStyle m + p_hsTypeR m = p_hsType' multilineArgs docStyle m +startTypeAnnotation :: + HasSrcSpan l => + GenLocated l a -> + (a -> R ()) -> + R () +startTypeAnnotation = startTypeAnnotation' breakpoint breakpoint + +startTypeAnnotationDecl :: + HasSrcSpan l => + GenLocated l a -> + (a -> HsType GhcPs) -> + (a -> R ()) -> + R () +startTypeAnnotationDecl lItem getType = + startTypeAnnotation' + ( if hasDocStrings $ getType $ unLoc lItem + then newline + else breakpoint + ) + breakpoint + lItem + +startTypeAnnotation' :: + HasSrcSpan l => + R () -> + R () -> + GenLocated l a -> + (a -> R ()) -> + R () +startTypeAnnotation' breakTrailing breakLeading lItem renderItem = + getPrinterOpt poFunctionArrows >>= \case + TrailingArrows -> do + space + dcolon + breakTrailing + located lItem renderItem + LeadingArrows -> do + breakLeading + located lItem $ \item -> do + dcolon + space + renderItem item + -- | Return 'True' if at least one argument in 'HsType' has a doc string -- attached to it. hasDocStrings :: HsType GhcPs -> Bool @@ -284,32 +285,29 @@ (if isInferred flag then braces N else id) $ p_rdrName x KindedTyVar _ flag l k -> (if isInferred flag then braces else parens) N . sitcc $ do located l atom - trailingArrowType - breakpoint - leadingArrowType - inci (located k p_hsType) + inci $ startTypeAnnotation k p_hsType data ForAllVisibility = ForAllInvis | ForAllVis -- | Render several @forall@-ed variables. p_forallBndrs :: ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R () p_forallBndrs vis p tyvars = do - p_forallBndrs' vis p tyvars - p_after False + p_forallBndrsStart p tyvars + p_forallBndrsEnd vis -p_forallBndrs' :: ForAllVisibility -> (a -> R ()) -> [LocatedA a] -> R () -p_forallBndrs' ForAllInvis _ [] = txt "forall" >> setPrevTypeCtx TypeCtxForall -p_forallBndrs' ForAllVis _ [] = txt "forall" >> space >> setPrevTypeCtx TypeCtxArgument -p_forallBndrs' vis p tyvars = do +p_forallBndrsStart :: (a -> R ()) -> [LocatedA a] -> R () +p_forallBndrsStart _ [] = forall +p_forallBndrsStart p tyvars = do switchLayout (getLocA <$> tyvars) $ do - txt "forall" + forall breakpoint inci $ do sitcc $ sep breakpoint (sitcc . located' p) tyvars - case vis of - ForAllInvis -> setPrevTypeCtx TypeCtxForall - ForAllVis -> space >> setPrevTypeCtx TypeCtxArgument +p_forallBndrsEnd :: ForAllVisibility -> R () +p_forallBndrsEnd ForAllInvis = txt "." >> space +p_forallBndrsEnd ForAllVis = space >> rarrow + p_conDeclFields :: [LConDeclField GhcPs] -> R () p_conDeclFields xs = braces N $ sep commaDel (sitcc . located' p_conDeclField) xs @@ -327,12 +325,12 @@ getPrinterOpt poFunctionArrows >>= \case LeadingArrows -> inci $ do breakpoint - txt "::" + dcolon space p_hsType (unLoc cd_fld_type) TrailingArrows -> do space - txt "::" + dcolon breakpoint sitcc . inci $ p_hsType (unLoc cd_fld_type) when (commaStyle == Leading) $ diff --git a/tests/Ormolu/Config/PrinterOptsSpec.hs b/tests/Ormolu/Config/PrinterOptsSpec.hs --- a/tests/Ormolu/Config/PrinterOptsSpec.hs +++ b/tests/Ormolu/Config/PrinterOptsSpec.hs @@ -1,4 +1,5 @@ {-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} @@ -9,11 +10,15 @@ -- testing. module Ormolu.Config.PrinterOptsSpec (spec) where +import Control.Exception (catch) import Control.Monad (forM_, when) import Data.Algorithm.DiffContext (getContextDiff, prettyContextDiff) +import Data.Char (isSpace) +import qualified Data.List.NonEmpty as NE import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T +import GHC.Stack (withFrozenCallStack) import Ormolu ( Config (..), PrinterOpts (..), @@ -23,10 +28,13 @@ detectSourceType, ormolu, ) +import Ormolu.Exception (OrmoluException, printOrmoluException) +import Ormolu.Terminal (ColorMode (..), runTerm) import Ormolu.Utils.IO (readFileUtf8, writeFileUtf8) import Path ( File, Path, + Rel, fromRelFile, parseRelDir, parseRelFile, @@ -35,9 +43,12 @@ ) import Path.IO (doesFileExist) import System.Environment (lookupEnv) +import System.IO (hClose) +import System.IO.Temp (withSystemTempFile) import System.IO.Unsafe (unsafePerformIO) import Test.Hspec import qualified Text.PrettyPrint as Doc +import Text.Printf (printf) data TestGroup = forall a. TestGroup @@ -50,8 +61,17 @@ spec :: Spec spec = + sequence_ + [ singleTests, + multiTests + ] + +-- Tests where each test group is a directory with an `input.hs` file and multiple `output-*.hs` +-- files that could be regenerated with ORMOLU_REGENERATE_EXAMPLES. +singleTests :: Spec +singleTests = mapM_ - runTestGroup + (runTestGroup False) [ TestGroup { label = "indentation", testCases = (,) <$> [2, 3, 4] <*> allOptions, @@ -116,6 +136,27 @@ testCaseSuffix = suffix1 }, TestGroup + { label = "let-style", + testCases = (,,) <$> allOptions <*> allOptions <*> [2, 4], + updateConfig = \(letStyle, inStyle, indent) opts -> + opts + { poIndentation = pure indent, + poLetStyle = pure letStyle, + poInStyle = pure inStyle + }, + showTestCase = \(letStyle, inStyle, indent) -> + printf "%s + %s (indent=%d)" (show letStyle) (show inStyle) indent, + testCaseSuffix = \(letStyle, inStyle, indent) -> + suffixWith [show letStyle, show inStyle, "indent=" ++ show indent] + }, + TestGroup + { label = "unicode-syntax", + testCases = allOptions, + updateConfig = \unicodePreference options -> options {poUnicode = pure unicodePreference}, + showTestCase = show, + testCaseSuffix = suffix1 + }, + TestGroup { label = "respectful", testCases = allOptions, updateConfig = \respectful opts -> opts {poRespectful = pure respectful}, @@ -123,42 +164,45 @@ testCaseSuffix = suffix1 } ] - where - allOptions :: (Enum a, Bounded a) => [a] - allOptions = [minBound .. maxBound] - suffixWith xs = concatMap ('-' :) . filter (not . null) $ xs - suffix1 a1 = suffixWith [show a1] +-- Same as 'singleTests', except with input taken from 'input-multi.hs', where sections +-- delimited by `{- // -}` will be formatted as separate Haskell files. Useful for testing +-- combinations of module headers, which is normally only allowed once. +multiTests :: Spec +multiTests = + mapM_ + (runTestGroup True) + [ TestGroup + { label = "respectful-module-where", + testCases = (,) <$> allOptions <*> allOptions, + updateConfig = \(respectful, importExportStyle) opts -> + opts + { poRespectful = pure respectful, + poImportExportStyle = pure importExportStyle + }, + showTestCase = \(respectful, importExportStyle) -> + (if respectful then "respectful" else "not respectful") ++ " + " ++ show importExportStyle, + testCaseSuffix = \(respectful, importExportStyle) -> + suffixWith ["respectful=" ++ show respectful, show importExportStyle] + } + ] -runTestGroup :: TestGroup -> Spec -runTestGroup TestGroup {..} = +runTestGroup :: Bool -> TestGroup -> Spec +runTestGroup isMulti TestGroup {..} = describe label $ forM_ testCases $ \testCase -> it ("generates the correct output for: " ++ showTestCase testCase) $ do - let inputFile = testDir toRelFile "input.hs" + let inputFile = testDir toRelFile (if isMulti then "input-multi.hs" else "input.hs") inputPath = fromRelFile inputFile outputFile = testDir toRelFile ("output" ++ testCaseSuffix testCase ++ ".hs") - outputPath = fromRelFile outputFile - config = - defaultConfig - { cfgPrinterOpts = updateConfig testCase defaultPrinterOpts, - cfgSourceType = detectSourceType inputPath, - cfgCheckIdempotence = True - } - runOrmolu path = ormolu config path . T.unpack + opts = updateConfig testCase defaultPrinterOpts input <- readFileUtf8 inputPath - actual <- runOrmolu inputPath input - mExpected <- getFileContents outputFile - case (shouldRegenerateOutput, mExpected) of - (False, Nothing) -> - expectationFailure "Output does not exist. Try running with ORMOLU_REGENERATE_EXAMPLES=1" - (False, Just expected) -> - when (actual /= expected) $ - expectationFailure . T.unpack $ - getDiff ("actual", actual) ("expected", expected) - (True, _) -> - writeFileUtf8 outputPath actual + actual <- + if isMulti + then overSectionsM (T.pack "{- // -}") (runOrmolu opts inputPath) input + else runOrmolu opts inputPath input + checkResult outputFile actual where testDir = toRelDir $ "data/fourmolu/" ++ label toRelDir name = @@ -170,8 +214,48 @@ Just path -> path Nothing -> error $ "Not a valid file name: " ++ show name +runOrmolu :: PrinterOptsTotal -> FilePath -> Text -> IO Text +runOrmolu opts inputPath input = + ormolu config inputPath (T.unpack input) `catch` \e -> do + msg <- renderOrmoluException e + expectationFailure' $ unlines ["Got ormolu exception:", "", msg] + where + config = + defaultConfig + { cfgPrinterOpts = opts, + cfgSourceType = detectSourceType inputPath, + cfgCheckIdempotence = True + } + +checkResult :: Path Rel File -> Text -> Expectation +checkResult outputFile actual + | shouldRegenerateOutput = writeFileUtf8 (fromRelFile outputFile) actual + | otherwise = + getFileContents outputFile >>= \case + Nothing -> + expectationFailure "Output does not exist. Try running with ORMOLU_REGENERATE_EXAMPLES=1" + Just expected -> + when (actual /= expected) $ + expectationFailure . T.unpack $ + getDiff ("actual", actual) ("expected", expected) + {--- Helpers ---} +allOptions :: (Enum a, Bounded a) => [a] +allOptions = [minBound .. maxBound] + +suffixWith :: [String] -> String +suffixWith xs = concatMap ('-' :) . filter (not . null) $ xs + +suffix1 :: Show a => a -> String +suffix1 a1 = suffixWith [show a1] + +overSectionsM :: Monad m => Text -> (Text -> m Text) -> Text -> m Text +overSectionsM delim f = + fmap T.concat + . mapM (\(s, isDelim) -> if isDelim then pure s else f s) + . splitOnDelim delim + getFileContents :: Path b File -> IO (Maybe Text) getFileContents path = do fileExists <- doesFileExist path @@ -185,8 +269,59 @@ prettyContextDiff (Doc.text s1Name) (Doc.text s2Name) (Doc.text . T.unpack) $ getContextDiff 2 (T.lines s1) (T.lines s2) +renderOrmoluException :: OrmoluException -> IO String +renderOrmoluException e = + withSystemTempFile "PrinterOptsSpec" $ \fp handle -> do + runTerm (printOrmoluException e) Never handle + hClose handle + readFile fp + +expectationFailure' :: HasCallStack => String -> IO a +expectationFailure' msg = do + withFrozenCallStack $ expectationFailure msg + -- satisfy type-checker, since hspec's expectationFailure is IO () + error "unreachable" + shouldRegenerateOutput :: Bool shouldRegenerateOutput = -- Use same env var as PrinterSpec.hs, to make it easy to regenerate everything at once unsafePerformIO $ isJust <$> lookupEnv "ORMOLU_REGENERATE_EXAMPLES" {-# NOINLINE shouldRegenerateOutput #-} + +{--- Utilities ---} + +-- | Group delimiter (including surrounding whitespace) and non-delimiter lines +-- and annotate lines with a Bool indicating if the group is a delimiter group +-- or not. +splitOnDelim :: Text -> Text -> [(Text, Bool)] +splitOnDelim delim = + map (\(lineGroup, delimType) -> (T.unlines lineGroup, isDelim delimType)) + . collapseSpaces NonDelim + . collapseSpaces Delim + . groupWith toLineType + . T.lines + where + toLineType line + | T.all isSpace line = Space + | line == delim = Delim + | otherwise = NonDelim + + collapseSpaces delimType = \case + (xs, Space) : (ys, ysType) : rest | ysType == delimType -> collapseSpaces delimType $ (xs ++ ys, delimType) : rest + (xs, xsType) : (ys, Space) : rest | xsType == delimType -> collapseSpaces delimType $ (xs ++ ys, delimType) : rest + x : rest -> x : collapseSpaces delimType rest + [] -> [] + + isDelim = \case + Delim -> True + NonDelim -> False + Space -> error "isDelim called on Space, but all Spaces should've been eliminated at this point" + + -- Like 'NE.groupWith', except annotates group with comparator + groupWith :: Eq b => (a -> b) -> [a] -> [([a], b)] + groupWith f = + let liftComparator xs = (map fst $ NE.toList xs, snd $ NE.head xs) + in map liftComparator . NE.groupWith snd . map (\a -> (a, f a)) + +data LineType = Space | Delim | NonDelim + deriving (Eq)