1
1
mirror of https://github.com/tweag/ormolu.git synced 2024-10-05 17:37:11 +03:00

Align opening/closing parentheses and other similar punctuation

This commit is contained in:
mrkkrp 2019-09-16 15:01:59 +02:00 committed by Mark Karpov
parent a4e97da37d
commit 87406cbd8f
103 changed files with 339 additions and 416 deletions

View File

@ -4,7 +4,7 @@
module
( 5
:: Int
)
)
#-}
{-# ANN foo "hey" #-}

View File

@ -13,7 +13,7 @@ class Bar a where
default bar
:: ( Read a,
Semigroup a
)
)
=> a
-> a
-> a

View File

@ -11,7 +11,7 @@ class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where
class
( Stream s, -- Token streams
MonadPlus m -- Potential for failure
)
)
=> MonadParsec e s m
| m -> e s where

View File

@ -6,4 +6,4 @@ class
Bar
( a -- Variable
:: * -- Star
)
)

View File

@ -11,7 +11,7 @@ class Baz a where
baz
:: ( a,
a -- ^ First argument
)
)
-> a -- ^ Second argument
-> a -- ^ Return value

View File

@ -10,5 +10,5 @@ class
( Foo a, -- Foo?
Bar a, -- Bar?
Baz a -- Baz
)
)
=> BarBar a

View File

@ -17,5 +17,5 @@ class
class
( f
:. g
)
)
a

View File

@ -12,5 +12,5 @@ class (f `Product` g) a
class
( f
`Sum` g
)
)
a

View File

@ -4,7 +4,7 @@ newtype Foo = Foo Int
deriving anyclass
( ToJSON,
FromJSON
)
)
deriving newtype (Num)
deriving (Monoid) via (Sum Int)
deriving

View File

@ -8,5 +8,5 @@ data Foo where
barBar,
bazBaz
:: Int
}
}
-> Foo

View File

@ -11,7 +11,7 @@ data (f :* g) a = f a :* g a
data
( f
:+ g
)
)
a
= L (f a)
| R (g a)
@ -23,7 +23,7 @@ data (f `Product` g) a = f a `Product` g a
data
( f
`Sum` g
)
)
a
= L' (f a)
| R' (g a)

View File

@ -9,10 +9,10 @@ data Foo
:: NonEmpty
( Indentity
Bool
),
),
-- ^ GagGog
fooFoo,
barBar
:: Int -- ^ Huh!
}
}
deriving (Eq, Show)

View File

@ -4,4 +4,4 @@ default
( Int,
Foo,
Bar
)
)

View File

@ -4,14 +4,14 @@ instance
Read
( c, -- Bar
d
)
)
)
)
=> Read
( a, -- Baz
b,
( c, -- Quux
d
)
)
)
where
readsPrec = undefined

View File

@ -3,7 +3,7 @@ instance Eq a => Eq [a] where (==) _ _ = False
instance
( Ord a,
Ord b
)
)
=> Ord (a, b)
where
compare _ _ = GT
@ -13,6 +13,6 @@ instance
=> Show
( a,
b
)
)
where
showsPrec _ _ = showString ""

View File

@ -4,4 +4,4 @@
newtype instance Foo [Double]
= DoubleListFoo
{ unDoubleListFoo :: Double
}
}

View File

@ -9,10 +9,10 @@ data instance
= IntListFoo
( Int,
Int
)
)
( Double,
Double
)
)
data instance Bar Double a
= DoubleBar

View File

@ -7,7 +7,7 @@ type instance
[Int] =
( Int,
Int
)
)
type instance Bar Int [Int] Double = (Int, Double)
@ -18,4 +18,4 @@ type instance
Double =
( Int,
Double
)
)

View File

@ -11,7 +11,7 @@
(a -> b -> b)
-> b
-> b
).
).
foldr k z (build g) =
g k z
#-}

View File

@ -7,7 +7,7 @@ class Foo a where
| ( b, c, d
| e,
f
)
)
| g
#-}

View File

@ -12,7 +12,7 @@ instance (Num r, V.Vector v r, Factored m r) => Num (VT v m r) where
{-# SPECIALIZE instance
( Factored m Int => Num (VT U.Vector m Int)
)
)
#-}
VT x + VT y = VT $ V.zipWith (+) x y

View File

@ -11,6 +11,6 @@ functionName
-> AnotherLongDataTypeName
-> b
-> c
)
)
-> (c -> d)
-> (a, b, c, d)

View File

@ -2,7 +2,7 @@ functionName
:: ( C1,
C2,
C3
)
)
=> a
-> b
-> c

View File

@ -10,6 +10,6 @@ functionName
-> AnotherLongDataTypeName4
-> b
-> c
)
)
-> (c -> d)
-> (a, b, c, d)

View File

@ -23,4 +23,4 @@ $( singletons
data T = T
deriving (Eq, Ord, Enum, Bounded, Show)
|]
)
)

View File

@ -2,6 +2,6 @@
x =
$$( foo bar
)
)
x = $$foo

View File

@ -5,6 +5,6 @@ x = $(foo bar)
x =
$( foo
bar
)
)
x = $foo

View File

@ -5,13 +5,13 @@ foo' = [0 .. 5]
bar x =
[ 0
.. x
]
]
baz x =
[ 1,
3
.. x
]
]
barbaz x = [0, 1 ..]

View File

@ -1,13 +1,14 @@
{-# LANGUAGE Arrows #-}
foo f g x y = (|test (f -< x) (g -< y)|)
foo f g x y = (| test (f -< x) (g -< y) |)
bar f g x y =
(| test
( f -<
x
)
( g -<
y
)
|)
(|
test
( f -<
x
)
( g -<
y
)
|)

View File

@ -13,6 +13,6 @@ bar f x =
( x, -- Foo
w, -- Bar
z -- Baz
)
)
baz x = proc a -> a -<< x

View File

@ -16,13 +16,13 @@ foo
f -- Call into f
( a,
c -- Tuple together arguments
)
)
( b,
d
) -<
) -<
( b + 1, -- Funnel into arrow
d * b
)
)
if x `mod` y == 0 -- Basic condition
then
case e of -- Only left case is relevant
@ -33,10 +33,11 @@ foo
let v =
u -- Actually never used
^ 2
in ( returnA -<
-- Just do the calculation
(x + y * z)
)
in ( returnA -<
-- Just do the calculation
(x + y * z)
)
else
do
let u = x -- Let bindings bind expressions, not commands
@ -47,8 +48,8 @@ foo
n ->
( ( h . g -<
y -- First actual use of y
)
)
)
returnA -< ()
-- Sometimes execute effects
if i > 0
@ -58,4 +59,4 @@ foo
( i
+ x
* y -- Just do the calculation
)
)

View File

@ -15,6 +15,6 @@ bazbaz f g h = proc (a, b, c) -> do
( a,
b,
c
)
)
returnA -<
(x, y, z)

View File

@ -1,18 +1,19 @@
{-# LANGUAGE Arrows #-}
foo0 f g x y = proc _ -> (|f (g -< (x, y))|)
foo0 f g x y = proc _ -> (| f (g -< (x, y)) |)
foo1 f g h x =
proc (y, z) ->
(| test
( h f
. h g -<
y x
. y z
)
( h g
. h f -<
y z
. y x
)
|)
(|
test
( h f
. h g -<
y x
. y z
)
( h g
. h f -<
y z
. y x
)
|)

View File

@ -2,7 +2,7 @@
bar0 f g h x =
proc (y, z) ->
(|test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x))|)
(| test (h f . (h g) -< (y x) . y z) ((h g) . h f -< y z . (y x)) |)
bar1 f g x y = proc _ -> f -< x &&& g -< y

View File

@ -9,4 +9,5 @@ bar f g = proc a ->
j =
g
. h
in id -< (h, j)
in id -< (h, j)

View File

@ -5,14 +5,14 @@ foo f = proc a -> (f -< a)
bar f g = proc a ->
( ( (f)
( g
)
) -<
)
) -<
( ( ( ( ( ( g
a
)
)
)
)
)
)
)
)
)

View File

@ -8,7 +8,7 @@ foo f g = proc (x, y) -> do
bar -<
( a,
b
)
)
rec p <-
f
p -<

View File

@ -4,7 +4,7 @@ handleStuff =
something,
\ExceptionB ->
somethingElse
]
]
handleStuff =
handle
@ -12,4 +12,4 @@ handleStuff =
bar,
baz
qux
]
]

View File

@ -3,9 +3,9 @@
foo' xs ys =
[ ( x,
y
)
)
| x <- xs,
y <- ys,
-- First comment
then reverse -- Second comment
]
]

View File

@ -3,7 +3,7 @@
bar' xs ys =
[ ( x,
y
)
)
| x <- xs,
y <- ys,
-- First comment
@ -11,5 +11,5 @@ bar' xs ys =
by
( x
+ y -- Second comment
)
]
)
]

View File

@ -3,9 +3,9 @@
baz' xs ys =
[ ( x,
y
)
)
| x <- xs,
y <- ys,
-- First comment
then group using permutations -- Second comment
]
]

View File

@ -3,14 +3,14 @@
quux' xs ys =
[ ( x,
y
)
)
| x <- xs,
y <- ys,
-- First comment
then group by
( x
+ y
)
)
-- Second comment
using groupWith -- Third comment
]
]

View File

@ -0,0 +1,9 @@
warningFor var place = do
guard $ isVariableName var
guard . not $ isInArray var place || isGuarded place
( if includeGlobals || isLocal var
then warningForLocals
else warningForGlobals
)
var
place

View File

@ -0,0 +1,6 @@
warningFor var place = do
guard $ isVariableName var
guard . not $ isInArray var place || isGuarded place
(if includeGlobals || isLocal var
then warningForLocals
else warningForGlobals) var place

View File

@ -0,0 +1,7 @@
scientifically :: (Scientific -> a) -> Parser a
scientifically h = do
something
( I.satisfy (\w -> w == 'e' || w == 'E')
*> fmap (h . Sci.scientific signedCoeff . (e +)) (signed decimal)
)
<|> return (h $ Sci.scientific signedCoeff e)

View File

@ -0,0 +1,7 @@
scientifically :: (Scientific -> a) -> Parser a
scientifically h = do
something
( I.satisfy (\w -> w == 'e' || w == 'E')
*> fmap (h . Sci.scientific signedCoeff . (e +)) (signed decimal)
)
<|> return (h $ Sci.scientific signedCoeff e)

View File

@ -5,6 +5,6 @@ wrapError
HasCatch outertag outer m'
=> HasCatch innertag inner (t m'),
HasCatch outertag outer m
)
)
=> (forall m'. HasCatch innertag inner m' => m' a)
-> m a

View File

@ -5,6 +5,6 @@ magnify
HasReader outertag outer m'
=> HasReader innertag inner (t m'),
HasReader outertag outer m
)
)
=> (forall m'. HasReader innertag inner m' => m' a)
-> m a

View File

@ -9,7 +9,7 @@ sort'
:: ( ?cmp
:: a -> a -> Bool,
?foo :: Int
)
)
=> [a]
-> [a]
sort' = sort

View File

@ -20,5 +20,5 @@ barbaz x y z w =
b,
c,
d
]
]
]
]

View File

@ -5,9 +5,9 @@ bar = (<> "hello")
baz =
( 1 * 2
+
)
)
( *
3 ^ 5
)
)
quux = (,) <$> foo <$> bar

View File

@ -9,7 +9,7 @@ baz x y z w =
h,
i,
j
)
)
| a <- -- Foo 1
x, -- Foo 2
b <- -- Bar 1
@ -32,4 +32,4 @@ baz x y z w =
-- Bar bar 3
j <- -- Bar baz 1
a + b -- Bar baz 2
]
]

View File

@ -16,4 +16,4 @@ quux
{ boom = a,
foom = b,
..
} = a + b
} = a + b

View File

@ -7,7 +7,7 @@ singleLine = case () of
multiline = case () of
$( x
+ y
) -> ()
) -> ()
$( y
"something"
) -> ()
) -> ()

View File

@ -18,7 +18,9 @@ z = True
z_multiline = True
where
(# | | _x
(#
| | _x
#) =
(# | | True
#)
(#
| | True
#)

View File

@ -3,7 +3,7 @@ foo = Foo {a = 3}
bar = Bar
{ abc = foo,
def = Foo {a = 10}
}
}
baz = Baz {}
@ -14,14 +14,14 @@ aLongVariableName =
{ short = baz,
aLongRecordFieldName = YetAnotherLongRecordName
{ yetAnotherLongRecordFieldName = "a long string"
},
},
aLongRecordFieldName2 = Just YetAnotherLongRecordName
{ yetAnotherLongRecordFieldName = "a long string",
yetAnotherLongRecordFieldName =
Just
"a long string"
},
},
aLongRecordFieldName3 = do
foo
bar
}
}

View File

@ -4,7 +4,7 @@ bar x =
x
{ abc = foo,
def = Foo {a = 10}
}
}
baz x = x {}

View File

@ -8,6 +8,6 @@ bar x y z = Bar
y,
z,
..
}
}
baz = Baz {..}

View File

@ -9,11 +9,11 @@ bar =
[ 1,
2,
3
]
]
baz :: StaticPtr Bool
baz =
static
( fun 1
2
)
)

View File

@ -1,4 +1,4 @@
handleStuff =
( let foo = foo
in foo
)
)

View File

@ -4,11 +4,11 @@ bar =
( 1,
2,
3
)
)
handleStuff =
( let foo = foo
in foo,
let bar = bar
in bar
)
)

View File

@ -5,5 +5,6 @@ foo = (# 1 | #)
bar = (# | | 2 | #)
baz =
(# | | | 10 | | | | |
#)
(#
| | | 10 | | | | |
#)

View File

@ -3,7 +3,8 @@
foo = (# 1, 2, 3 #)
bar =
(# 1,
2,
3
#)
(#
1,
2,
3
#)

View File

@ -6,5 +6,5 @@ main = do
migration3
-- When adding migrations here, don't forget to update
-- 'schemaVersion' in Galley.Data
]
]
`finally` Log.close

View File

@ -3,4 +3,4 @@ x =
[ 1,
2,
somethingSomething 3
]
]

View File

@ -8,7 +8,7 @@ pattern Arrow {t1, t2} = App "->" [t1, t2]
pattern Arrow
{ t1,
t2
}
}
= App "->" [t1, t2]
pattern Int

View File

@ -14,7 +14,7 @@ pattern FirstTwo {x, y}
pattern FirstTwo'
{ x,
y
}
}
<- x : (y : xs)
pattern Simple <- "Simple"

View File

@ -3,7 +3,7 @@
foo
[ "These are bad functions",
"Really bad!"
]
]
#-}
test :: IO ()
test = pure ()

View File

@ -8,5 +8,5 @@ import qualified MegaModule as M
MonadBaseControl,
join,
liftIO,
void
)
void,
)

View File

@ -2,5 +2,5 @@ import qualified MegaModule as M
( -- (1)
(<<<), -- (2)
(>>>),
Either -- (3)
)
Either, -- (3)
)

View File

@ -5,7 +5,7 @@ import A hiding
foobarbazqux,
foobarbazqux,
foobarbazqux,
foobarbazqux
)
foobarbazqux,
)
import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)
import Name hiding ()

View File

@ -6,5 +6,5 @@ import qualified MegaModule as M
( (>>),
(>>=),
return
)
)
),
)

View File

@ -3,8 +3,8 @@
module ExportSyntax
( A (.., NoA),
Q (F, ..),
G (T, .., U)
)
G (T, .., U),
)
where
data A = A | B

View File

@ -1,6 +1,6 @@
module Foo
( foo,
bar,
baz
)
baz,
)
where

View File

@ -14,8 +14,8 @@ module My.Module
bar2, -- a multiline comment
-- the second line
bar3,
module Foo.Bar.Baz
)
module Foo.Bar.Baz,
)
where
-- Wow

View File

@ -1,6 +1,6 @@
module Foo
( foo,
bar,
baz
)
baz,
)
where

View File

@ -2,10 +2,10 @@ module Test
{-# DEPRECATED
[ "This module is deprecated.",
"Please use OtherModule instead."
]
]
#-}
( foo,
bar,
baz
)
baz,
)
where

View File

@ -2,8 +2,8 @@ module Test
{-# DEPRECATED "This module is unstable" #-}
( foo,
bar,
baz
)
baz,
)
where
import Blah

View File

@ -3,6 +3,6 @@ xs =
[ inner list first item,
inner list second item
-- inner list last item commented
],
],
outer list item
]
]

View File

@ -5,4 +5,4 @@ newNames =
-- Foo
-- Bar
]
]

View File

@ -5,7 +5,7 @@ foo xs = baz
[ lookup langKey gets, -- 1
lookup langKey cookies, -- 2
lookupText langKey session -- 3
]
]
++ xs -- 4
-- Blah

View File

@ -1,4 +0,0 @@
[ foo,
bar,
baz
]

View File

@ -1 +0,0 @@
[foo, bar, baz]

View File

@ -1,8 +0,0 @@
[ foo,
bar,
foo
:: ( Int
-> Int
)
-> Bool
]

View File

@ -1 +0,0 @@
[foo, bar, foo :: (Int -> Int) -> Bool]

View File

@ -1,7 +0,0 @@
module MyModule
( R,
runR,
txt,
blah
)
where

View File

@ -1,3 +0,0 @@
module MyModule
(R, runR, txt, blah)
where

View File

@ -1,5 +0,0 @@
foo
:: ( Int
-> Int
)
-> Bool

View File

@ -1 +0,0 @@
foo :: (Int -> Int) -> Bool

View File

@ -51,7 +51,6 @@ data-files: data/examples/declaration/annotation/*.hs
, data/examples/import/*.hs
, data/examples/module-header/*.hs
, data/examples/other/*.hs
, data/printer/*.hs
source-repository head
type: git
@ -136,8 +135,7 @@ test-suite tests
, text >= 0.2 && < 1.3
build-tools: hspec-discover >= 2.0 && < 3.0
other-modules:
Ormolu.Printer.CombinatorsSpec
, Ormolu.Parser.PragmaSpec
Ormolu.Parser.PragmaSpec
, Ormolu.PrinterSpec
if flag(dev)

View File

@ -9,10 +9,10 @@ module Ormolu.Exception
where
import Control.Exception
import Data.Text (Text)
import Ormolu.Utils (showOutputable)
import System.Exit (ExitCode (..), exitWith)
import System.IO
import Data.Text (Text)
import qualified GHC
import qualified Outputable as GHC
@ -54,7 +54,6 @@ instance Exception OrmoluException where
[ "before: " ++ show left , "after: " ++ show right ]
++ "Please, consider reporting the bug.\n"
-- | Inside this wrapper 'OrmoluException' will be caught and displayed
-- nicely using 'displayException'.

View File

@ -32,12 +32,12 @@ module Ormolu.Printer.Combinators
, useBraces
, dontUseBraces
-- ** Wrapping
, BracketStyle (..)
, sitcc
, backticks
, banana
, braces
, brackets
, bracketsPar
, parens
, parensHash
, pragmaBraces
@ -180,6 +180,12 @@ sepSemi f xs = vlayout singleLine multiLine
----------------------------------------------------------------------------
-- Wrapping
-- | 'BracketStyle' controlling how closing bracket is rendered.
data BracketStyle
= N -- ^ Normal
| S -- ^ Shifted one level
-- | Surround given entity by backticks.
backticks :: R () -> R ()
@ -191,61 +197,37 @@ backticks m = do
-- | Surround given entity by banana brackets (i.e., from arrow notation.)
banana :: R () -> R ()
banana m = sitcc $ do
txt "(|"
ospaces m
txt "|)"
banana = brackets_ True "(|" "|)" N
-- | Surround given entity by curly braces @{@ and @}@.
braces :: R () -> R ()
braces m = sitcc $ do
txt "{"
ospaces m
txt "}"
braces :: BracketStyle -> R () -> R ()
braces = brackets_ False "{" "}"
-- | Surround given entity by square brackets @[@ and @]@.
brackets :: R () -> R ()
brackets m = sitcc $ do
txt "["
ospaces m
txt "]"
-- | Surround given entity by parallel array brackets @[:@ and @:]@.
bracketsPar :: R () -> R ()
bracketsPar m = sitcc $ do
txt "[: "
m
vlayout (return ()) space
txt " :]"
brackets :: BracketStyle -> R () -> R ()
brackets = brackets_ False "[" "]"
-- | Surround given entity by parentheses @(@ and @)@.
parens :: R () -> R ()
parens m = sitcc $ do
txt "("
ospaces m
txt ")"
parens :: BracketStyle -> R () -> R ()
parens = brackets_ False "(" ")"
-- | Surround given entity by @(# @ and @ #)@.
parensHash :: R () -> R ()
parensHash m = sitcc $ do
txt "(# "
m
vlayout space (newline >> txt " ")
txt "#)"
parensHash :: BracketStyle -> R () -> R ()
parensHash = brackets_ True "(#" "#)"
-- | Braces as used for pragmas: @{-#@ and @#-}@.
pragmaBraces :: R () -> R ()
pragmaBraces m = sitcc $ do
txt "{-# "
txt "{-#"
space
m
vlayout space (newline >> txt " ")
txt "#-}"
breakpoint
inci (txt "#-}")
-- | Surround the body with a pragma name and 'pragmaBraces'.
@ -258,15 +240,32 @@ pragma pragmaText body = pragmaBraces $ do
breakpoint
body
-- | Surround given entity by optional space before and a newline after, iff
-- current layout is multiline.
-- | A helper for defining wrappers like 'parens' and 'braces'.
ospaces :: R () -> R ()
ospaces m = vlayout m $ do
space
sitcc m
newline
txt " "
brackets_
:: Bool -- ^ Insert breakpoints around brackets
-> Text -- ^ Opening bracket
-> Text -- ^ Closing bracket
-> BracketStyle -- ^ Bracket style
-> R () -- ^ Inner expression
-> R ()
brackets_ needBreaks open close style m = sitcc (vlayout singleLine multiLine)
where
singleLine = do
txt open
when needBreaks space
m
when needBreaks space
txt close
multiLine = do
txt open
if needBreaks
then newline >> inci m
else space >> sitcc m
newline
case style of
N -> txt close
S -> inci (txt close)
----------------------------------------------------------------------------
-- Literals

View File

@ -11,6 +11,7 @@ module Ormolu.Printer.Meat.Common
, doesNotNeedExtraParens
, p_qualName
, p_infixDefHelper
, p_trailingCommaFor
)
where
@ -57,7 +58,7 @@ p_rdrName l@(L spn _) = located l $ \x -> do
else id
parensWrapper =
if AnnOpenP `elem` ids
then parens
then parens N
else id
singleQuoteWrapper =
if AnnSimpleQuote `elem` ids
@ -123,7 +124,7 @@ p_infixDefHelper isInfix inci' name args =
let parens' =
if null ps
then id
else parens
else parens N
parens' $ do
p0
breakpoint
@ -139,3 +140,14 @@ p_infixDefHelper isInfix inci' name args =
unless (null ps) $ do
breakpoint
inci' $ sitcc (sep breakpoint sitcc args)
-- | Insert a trailing comma when the given collection is not empty and
-- we're in multi-line layout.
p_trailingCommaFor
:: [a] -- ^ Collection to print trailing comma for
-> R ()
p_trailingCommaFor xs =
vlayout
(return ())
(unless (null xs) comma)

View File

@ -157,7 +157,7 @@ p_hsDerivingClause HsDerivingClause {..} = do
txt "deriving"
let derivingWhat = located deriv_clause_tys $ \case
[] -> txt "()"
xs -> parens . sitcc $ sep
xs -> parens N . sitcc $ sep
(comma >> breakpoint)
(sitcc . located' p_hsType . hsib_body)
xs

View File

@ -16,6 +16,6 @@ p_defaultDecl = \case
DefaultDecl NoExt ts -> do
txt "default"
breakpoint
inci . parens . sitcc $
inci . parens N . sitcc $
sep (comma >> breakpoint) (sitcc . located' p_hsType) ts
XDefaultDecl {} -> notImplemented "XDefaultDecl"

View File

@ -55,7 +55,7 @@ p_ruleBndrs bndrs =
p_ruleBndr :: RuleBndr GhcPs -> R ()
p_ruleBndr = \case
RuleBndr NoExt x -> p_rdrName x
RuleBndrSig NoExt x hswc -> parens $ do
RuleBndrSig NoExt x hswc -> parens N $ do
p_rdrName x
p_typeAscription hswc
XRuleBndr NoExt -> notImplemented "XRuleBndr"

View File

@ -174,7 +174,7 @@ p_booleanFormula = \case
(breakpoint >> txt "| ")
(located' p_booleanFormula)
xs
Parens l -> located l (parens . p_booleanFormula)
Parens l -> located l (parens N . p_booleanFormula)
p_completeSig
:: Located [Located RdrName] -- ^ Constructors\/patterns

View File

@ -310,7 +310,7 @@ p_hsCmd = \case
-- does. Open an issue and ping @yumiova if this ever occurs in output.
notImplemented "HsCmdApp"
HsCmdLam NoExt mgroup -> p_matchGroup' cmdPlacement p_hsCmd Lambda mgroup
HsCmdPar NoExt c -> parens (located c p_hsCmd)
HsCmdPar NoExt c -> parens N (located c p_hsCmd)
HsCmdCase NoExt e mgroup -> do
txt "case"
space
@ -338,6 +338,7 @@ p_hsCmd = \case
space
sitcc (located localBinds p_hsLocalBinds)
breakpoint
vlayout space (newline >> txt " ")
txt "in"
space
sitcc (located c p_hsCmd)
@ -486,7 +487,10 @@ p_hsTupArg = \case
XTupArg {} -> notImplemented "XTupArg"
p_hsExpr :: HsExpr GhcPs -> R ()
p_hsExpr = \case
p_hsExpr = p_hsExpr' N
p_hsExpr' :: BracketStyle -> HsExpr GhcPs -> R ()
p_hsExpr' s = \case
HsVar NoExt name -> p_rdrName name
HsUnboundVar NoExt _ -> notImplemented "HsUnboundVar"
HsConLikeOut NoExt _ -> notImplemented "HsConLikeOut"
@ -504,8 +508,8 @@ p_hsExpr = \case
HsOverLit NoExt v -> atom (ol_val v)
HsLit NoExt lit ->
case lit of
HsString (SourceText s) _ -> p_stringLit s
HsStringPrim (SourceText s) _ -> p_stringLit s
HsString (SourceText stxt) _ -> p_stringLit stxt
HsStringPrim (SourceText stxt) _ -> p_stringLit stxt
r -> atom r
HsLam NoExt mgroup ->
p_matchGroup Lambda mgroup
@ -519,8 +523,8 @@ p_hsExpr = \case
-- and then use 'p_withoutHanging' for the descendants.
let p_withoutHanging (HsApp NoExt f' x') = do
case f' of
(L _ (HsApp _ _ _)) -> located f' p_withoutHanging
_ -> located f' p_hsExpr
L _ (HsApp _ _ _) -> located f' p_withoutHanging
_ -> located f' (p_hsExpr' s)
breakpoint
inci $ located x' p_hsExpr
p_withoutHanging e = p_hsExpr e
@ -552,12 +556,12 @@ p_hsExpr = \case
getOpName = \case
HsVar NoExt (L _ a) -> Just a
_ -> Nothing
p_exprOpTree (reassociateOpTree getOpName opTree)
p_exprOpTree s (reassociateOpTree getOpName opTree)
NegApp NoExt e _ -> do
txt "-"
space
located e p_hsExpr
HsPar NoExt e -> parens (located e p_hsExpr)
HsPar NoExt e -> parens s (located e p_hsExpr)
SectionL NoExt x op -> do
located x p_hsExpr
breakpoint
@ -576,12 +580,12 @@ p_hsExpr = \case
Boxed -> parens
Unboxed -> parensHash
if isSection
then switchLayout [] . parens' $
then switchLayout [] . parens' s $
sep comma (located' p_hsTupArg) args
else switchLayout (getLoc <$> args) . parens' . sitcc $
else switchLayout (getLoc <$> args) . parens' s . sitcc $
sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
ExplicitSum NoExt tag arity e ->
p_unboxedSum tag arity (located e p_hsExpr)
p_unboxedSum N tag arity (located e p_hsExpr)
HsCase NoExt e mgroup -> do
txt "case"
space
@ -620,8 +624,8 @@ p_hsExpr = \case
txt header
breakpoint
ub <- vlayout (return useBraces) (return id)
inci $ sepSemi (located' (ub . p_stmt)) (unLoc es)
compBody = brackets $ located es $ \xs -> do
inci $ sepSemi (located' (ub . p_stmt' (p_hsExpr' S))) (unLoc es)
compBody = brackets N $ located es $ \xs -> do
let p_parBody = sep
(breakpoint >> txt "| ")
p_seqBody
@ -647,7 +651,8 @@ p_hsExpr = \case
ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
ExplicitList _ _ xs ->
brackets . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
brackets s . sitcc $
sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
RecordCon {..} -> do
located rcon_con_name atom
breakpoint
@ -662,7 +667,8 @@ p_hsExpr = \case
case rec_dotdot of
Just {} -> [txt ".."]
Nothing -> []
inci . braces . sitcc $ sep (comma >> breakpoint) sitcc (fields <> dotdot)
inci . braces N . sitcc $
sep (comma >> breakpoint) sitcc (fields <> dotdot)
RecordUpd {..} -> do
located rupd_expr p_hsExpr
breakpoint
@ -672,7 +678,7 @@ p_hsExpr = \case
Unambiguous _ n -> n
XAmbiguousFieldOcc _ -> notImplemented "XAmbiguousFieldOcc"
}
inci . braces . sitcc $
inci . braces N . sitcc $
sep
(comma >> breakpoint)
(sitcc . located' (p_hsRecField . updName))
@ -688,21 +694,21 @@ p_hsExpr = \case
located hsib_body p_hsType
ArithSeq NoExt _ x -> do
case x of
From from -> brackets . sitcc $ do
From from -> brackets s . sitcc $ do
located from p_hsExpr
breakpoint
txt ".."
FromThen from next -> brackets . sitcc $ do
FromThen from next -> brackets s . sitcc $ do
sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
breakpoint
txt ".."
FromTo from to -> brackets . sitcc $ do
FromTo from to -> brackets s . sitcc $ do
located from p_hsExpr
breakpoint
txt ".."
space
located to p_hsExpr
FromThenTo from next to -> brackets . sitcc $ do
FromThenTo from next to -> brackets s . sitcc $ do
sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
breakpoint
txt ".."
@ -799,7 +805,7 @@ p_patSynBind PSB {..} = do
inci $ do
switchLayout (getLoc . recordPatSynPatVar <$> xs) $ do
unless (null xs) breakpoint
braces . sitcc $
braces N . sitcc $
sep (comma >> breakpoint) (p_rdrName . recordPatSynPatVar) xs
breakpoint
rhs
@ -829,20 +835,20 @@ p_pat = \case
txt "@"
located pat p_pat
ParPat NoExt pat ->
located pat (parens . p_pat)
located pat (parens S . p_pat)
BangPat NoExt pat -> do
txt "!"
located pat p_pat
ListPat NoExt pats -> do
brackets . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
brackets S . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
TuplePat NoExt pats boxing -> do
let f =
case boxing of
Boxed -> parens
Unboxed -> parensHash
Boxed -> parens S
Unboxed -> parensHash S
f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
SumPat NoExt pat tag arity ->
p_unboxedSum tag arity (located pat p_pat)
p_unboxedSum S tag arity (located pat p_pat)
ConPatIn pat details ->
case details of
PrefixCon xs -> sitcc $ do
@ -856,9 +862,10 @@ p_pat = \case
let f = \case
Nothing -> txt ".."
Just x -> located x p_pat_hsRecField
inci . braces . sitcc . sep (comma >> breakpoint) f $ case dotdot of
Nothing -> Just <$> fields
Just n -> (Just <$> take n fields) ++ [Nothing]
inci . braces N . sitcc . sep (comma >> breakpoint) f $
case dotdot of
Nothing -> Just <$> fields
Just n -> (Just <$> take n fields) ++ [Nothing]
InfixCon x y -> do
located x p_pat
space
@ -898,8 +905,8 @@ p_pat_hsRecField HsRecField {..} = do
breakpoint
inci (located hsRecFieldArg p_pat)
p_unboxedSum :: ConTag -> Arity -> R () -> R ()
p_unboxedSum tag arity m = do
p_unboxedSum :: BracketStyle -> ConTag -> Arity -> R () -> R ()
p_unboxedSum s tag arity m = do
let before = tag - 1
after = arity - before - 1
args = replicate before Nothing <> [Just m] <> replicate after Nothing
@ -913,7 +920,7 @@ p_unboxedSum tag arity m = do
unless isFirst space
m'
unless isLast space
parensHash $ sep (txt "|") f (zip args [0..])
parensHash s $ sep (txt "|") f (zip args [0..])
p_hsSplice :: HsSplice GhcPs -> R ()
p_hsSplice = \case
@ -938,7 +945,7 @@ p_hsSpliceTH
p_hsSpliceTH isTyped expr = \case
HasParens -> do
txt decoSymbol
parens (located expr (sitcc . p_hsExpr))
parens N (located expr (sitcc . p_hsExpr))
HasDollar -> do
txt decoSymbol
located expr (sitcc . p_hsExpr)
@ -971,7 +978,7 @@ p_hsBracket = \case
(\i -> isPunctuation i || isSymbol i)
(showOutputable (rdrNameOcc name))
&& not (doesNotNeedExtraParens name)
wrapper = if isOperator then parens else id
wrapper = if isOperator then parens N else id
wrapper $ p_rdrName (noLoc name)
TExpBr NoExt expr -> do
txt "[||"
@ -1136,9 +1143,9 @@ exprOpTree :: LHsExpr GhcPs -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs)
exprOpTree (L _ (OpApp NoExt x op y)) = OpBranch (exprOpTree x) op (exprOpTree y)
exprOpTree n = OpNode n
p_exprOpTree :: OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree (OpNode x) = located x p_hsExpr
p_exprOpTree (OpBranch x op y) = do
p_exprOpTree :: BracketStyle -> OpTree (LHsExpr GhcPs) (LHsExpr GhcPs) -> R ()
p_exprOpTree s (OpNode x) = located x (p_hsExpr' s)
p_exprOpTree s (OpBranch x op y) = do
-- NOTE If the beginning of the first argument and the second argument
-- are on the same line, and the second argument has a hanging form, use
-- hanging placement.
@ -1158,12 +1165,12 @@ p_exprOpTree (OpBranch x op y) = do
Hanging -> useBraces
Normal -> dontUseBraces)
switchLayout [opTreeLoc x] $
ub $ p_exprOpTree x
ub $ p_exprOpTree s x
placeHanging placement $ do
located op (opWrapper . p_hsExpr)
space
switchLayout [opTreeLoc y] $
p_exprOpTree y
p_exprOpTree N y
-- | Get annotations for the enclosing element.

View File

@ -48,4 +48,4 @@ warningText = \case
p_lits :: [Located StringLiteral] -> R ()
p_lits = \case
[l] -> atom l
ls -> brackets . sitcc $ sep (comma >> breakpoint) atom ls
ls -> brackets N . sitcc $ sep (comma >> breakpoint) atom ls

View File

@ -23,7 +23,9 @@ p_hsmodExports [] = do
breakpoint'
txt ")"
p_hsmodExports xs =
parens . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_lie) xs
parens N . sitcc $ do
sep (comma >> breakpoint) (sitcc . located' p_lie) xs
p_trailingCommaFor xs
p_hsmodImport :: ImportDecl GhcPs -> R ()
p_hsmodImport ImportDecl {..} = do
@ -55,10 +57,11 @@ p_hsmodImport ImportDecl {..} = do
when hiding (txt "hiding")
case ideclHiding of
Nothing -> return ()
Just (_, (L _ a)) -> do
Just (_, (L _ xs)) -> do
breakpoint
parens . sitcc $
sep (comma >> breakpoint) (sitcc . located' p_lie) a
parens N . sitcc $ do
sep (comma >> breakpoint) (sitcc . located' p_lie) xs
p_trailingCommaFor xs
newline
p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"
@ -77,12 +80,13 @@ p_lie = \case
inci $ do
let names :: [R ()]
names = located' p_ieWrappedName <$> xs
parens . sitcc . sep (comma >> breakpoint) sitcc $
case w of
NoIEWildcard -> names
IEWildcard n ->
let (before, after) = splitAt n names
in before ++ [txt ".."] ++ after
parens N . sitcc $
sep (comma >> breakpoint) sitcc $
case w of
NoIEWildcard -> names
IEWildcard n ->
let (before, after) = splitAt n names
in before ++ [txt ".."] ++ after
IEModuleContents NoExt l1 -> located l1 p_hsmodName
-- XXX I have no idea what these things are for.
IEGroup NoExt _ _ -> return ()

Some files were not shown because too many files have changed in this diff Show More