mirror of
https://github.com/ilyakooo0/ormolu.git
synced 2024-10-27 03:28:33 +03:00
Change parens style and how separated lists of items are printed
Goals: * Make the set of combinators clearer and smaller. * Solve a number of issues, such as those about parse failures related to patterns. * Solve the bug from #244. The idea is very simple, we stop doing this ( foo , bar ) and start doing this ( foo, bar ) * We switch to trailing commas which solves the indentation issues for patterns automatically. * The new general ‘sep’ combinator finally is clear enough, and all the old zoo of ‘velt’ and ‘velt'’ and ‘sepWith’, etc. which was confusing and overlapping goes away.
This commit is contained in:
parent
180df38a71
commit
85d5f78b4b
@ -20,8 +20,8 @@ class Bar a where
|
||||
|
||||
-- Pointless comment
|
||||
default bar
|
||||
:: ( Read a
|
||||
, Semigroup a
|
||||
:: ( Read a,
|
||||
Semigroup a
|
||||
)
|
||||
=> a
|
||||
-> a
|
||||
|
@ -9,8 +9,8 @@ class (MonadReader r s, MonadWriter w m) => MonadState s m | m -> s where
|
||||
|
||||
-- | 'MonadParsec'
|
||||
class
|
||||
( Stream s -- Token streams
|
||||
, MonadPlus m -- Potential for failure
|
||||
( Stream s, -- Token streams
|
||||
MonadPlus m -- Potential for failure
|
||||
)
|
||||
=> MonadParsec e s m
|
||||
| m -> e s where
|
||||
|
@ -10,10 +10,10 @@ class Bar a b | a -> b, b -> a where
|
||||
-- | Something else.
|
||||
class
|
||||
Baz a b c d
|
||||
| a b -> c d -- Foo
|
||||
, b c -> a d -- Bar
|
||||
, a c -> b d -- Baz
|
||||
, a c d -> b
|
||||
, a b d -> a b c d where
|
||||
| a b -> c d, -- Foo
|
||||
b c -> a d, -- Bar
|
||||
a c -> b d, -- Baz
|
||||
a c d -> b,
|
||||
a b d -> a b c d where
|
||||
|
||||
baz :: a -> b
|
||||
|
@ -13,8 +13,8 @@ class Baz a where
|
||||
|
||||
-- | Baz
|
||||
baz
|
||||
:: ( a
|
||||
, a -- ^ First argument
|
||||
:: ( a,
|
||||
a -- ^ First argument
|
||||
)
|
||||
-> a -- ^ Second argument
|
||||
-> a -- ^ Return value
|
||||
|
@ -7,8 +7,8 @@ class
|
||||
=> Baz a
|
||||
|
||||
class
|
||||
( Foo a -- Foo?
|
||||
, Bar a -- Bar?
|
||||
, Baz a -- Baz
|
||||
( Foo a, -- Foo?
|
||||
Bar a, -- Bar?
|
||||
Baz a -- Baz
|
||||
)
|
||||
=> BarBar a
|
||||
|
@ -2,8 +2,8 @@
|
||||
newtype Foo = Foo Int
|
||||
deriving stock (Eq, Show, Generic)
|
||||
deriving anyclass
|
||||
( ToJSON
|
||||
, FromJSON
|
||||
( ToJSON,
|
||||
FromJSON
|
||||
)
|
||||
deriving newtype (Num)
|
||||
deriving (Monoid) via (Sum Int)
|
||||
|
@ -2,14 +2,14 @@ data GADT0 a where
|
||||
GADT01, GADT02 :: Int -> GADT0 a
|
||||
|
||||
data GADT1 a where
|
||||
GADT11
|
||||
, GADT12
|
||||
GADT11,
|
||||
GADT12
|
||||
:: Int
|
||||
-> GADT1 a
|
||||
|
||||
data GADT2 a where
|
||||
GADT21
|
||||
, GADT21
|
||||
, GADT22
|
||||
GADT21,
|
||||
GADT21,
|
||||
GADT22
|
||||
:: Int
|
||||
-> GADT2 a
|
||||
|
@ -2,10 +2,11 @@
|
||||
data Foo where
|
||||
Foo :: {fooX :: Int} -> Foo
|
||||
Bar
|
||||
:: { fooY :: Int
|
||||
, fooBar, fooBaz :: Bool
|
||||
, fooFoo
|
||||
, barBar
|
||||
:: { fooY :: Int,
|
||||
fooBar, fooBaz :: Bool,
|
||||
fooFoo,
|
||||
barBar,
|
||||
bazBaz
|
||||
:: Int
|
||||
}
|
||||
-> Foo
|
||||
|
@ -5,5 +5,6 @@ data Foo where
|
||||
Bar :: { fooY :: Int
|
||||
, fooBar, fooBaz :: Bool
|
||||
, fooFoo
|
||||
, barBar :: Int
|
||||
, barBar
|
||||
, bazBaz :: Int
|
||||
} -> Foo
|
||||
|
@ -1,18 +1,18 @@
|
||||
-- | Something.
|
||||
data Foo
|
||||
= Foo
|
||||
{ fooX :: Int -- ^ X
|
||||
, fooY :: Int -- ^ Y
|
||||
, fooBar, fooBaz :: NonEmpty (Identity Bool) -- ^ BarBaz
|
||||
, fooGag
|
||||
, fooGog
|
||||
{ fooX :: Int, -- ^ X
|
||||
fooY :: Int, -- ^ Y
|
||||
fooBar, fooBaz :: NonEmpty (Identity Bool), -- ^ BarBaz
|
||||
fooGag,
|
||||
fooGog
|
||||
:: NonEmpty
|
||||
( Indentity
|
||||
Bool
|
||||
)
|
||||
),
|
||||
-- ^ GagGog
|
||||
, fooFoo
|
||||
, barBar
|
||||
fooFoo,
|
||||
barBar
|
||||
:: Int -- ^ Huh!
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
@ -1,7 +1,7 @@
|
||||
default (Int, Foo, Bar)
|
||||
|
||||
default
|
||||
( Int
|
||||
, Foo
|
||||
, Bar
|
||||
( Int,
|
||||
Foo,
|
||||
Bar
|
||||
)
|
||||
|
@ -3,38 +3,41 @@ instance Eq a => Eq [a] where
|
||||
(==) _ _ = False
|
||||
|
||||
instance
|
||||
( Ord a
|
||||
, Ord b
|
||||
( Ord a,
|
||||
Ord b
|
||||
)
|
||||
=> Ord (a, b) where
|
||||
=> Ord (a, b)
|
||||
where
|
||||
|
||||
compare _ _ = GT
|
||||
|
||||
instance
|
||||
(Show a, Show b)
|
||||
=> Show
|
||||
( a
|
||||
, b
|
||||
) where
|
||||
( a,
|
||||
b
|
||||
)
|
||||
where
|
||||
|
||||
showsPrec _ _ = showString ""
|
||||
|
||||
instance
|
||||
( Read a -- Foo
|
||||
, Read b
|
||||
, Read
|
||||
( c
|
||||
, -- Bar
|
||||
( Read a, -- Foo
|
||||
Read b,
|
||||
Read
|
||||
( c,
|
||||
-- Bar
|
||||
d
|
||||
)
|
||||
)
|
||||
=> Read
|
||||
( a
|
||||
, -- Baz
|
||||
b
|
||||
, ( c -- Quux
|
||||
, d
|
||||
( a,
|
||||
-- Baz
|
||||
b,
|
||||
( c, -- Quux
|
||||
d
|
||||
)
|
||||
) where
|
||||
)
|
||||
where
|
||||
|
||||
readsPrec = undefined
|
||||
|
@ -7,11 +7,11 @@ data instance
|
||||
Foo
|
||||
[Int]
|
||||
= IntListFoo
|
||||
( Int
|
||||
, Int
|
||||
( Int,
|
||||
Int
|
||||
)
|
||||
( Double
|
||||
, Double
|
||||
( Double,
|
||||
Double
|
||||
)
|
||||
|
||||
newtype instance Foo [Double]
|
||||
|
@ -13,6 +13,7 @@ instance {-# OVERLAPS #-} Eq Double where
|
||||
instance
|
||||
{-# INCOHERENT #-}
|
||||
Ord
|
||||
Double where
|
||||
Double
|
||||
where
|
||||
|
||||
compare _ _ = GT
|
||||
|
@ -5,8 +5,8 @@ type instance Foo Int = Int
|
||||
type instance
|
||||
Foo
|
||||
[Int] =
|
||||
( Int
|
||||
, Int
|
||||
( Int,
|
||||
Int
|
||||
)
|
||||
|
||||
type instance Bar Int [Int] Double = (Int, Double)
|
||||
@ -16,6 +16,6 @@ type instance
|
||||
[Int]
|
||||
[Int]
|
||||
Double =
|
||||
( Int
|
||||
, Double
|
||||
( Int,
|
||||
Double
|
||||
)
|
||||
|
@ -3,8 +3,8 @@
|
||||
{-# COMPLETE A, B #-}
|
||||
|
||||
{-# COMPLETE
|
||||
A
|
||||
, B
|
||||
, C
|
||||
A,
|
||||
B,
|
||||
C
|
||||
:: Foo
|
||||
#-}
|
||||
|
@ -5,8 +5,8 @@ class Foo a where
|
||||
{-# MINIMAL
|
||||
a
|
||||
| ( b, c, d
|
||||
| e
|
||||
, f
|
||||
| e,
|
||||
f
|
||||
)
|
||||
| g
|
||||
#-}
|
||||
|
@ -17,8 +17,8 @@ baz = id
|
||||
{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
|
||||
{-# SPECIALIZE fits13Bits
|
||||
:: Int
|
||||
-> Bool
|
||||
, Integer -> Bool
|
||||
-> Bool,
|
||||
Integer -> Bool
|
||||
#-}
|
||||
fits13Bits :: Integral a => a -> Bool
|
||||
fits13Bits x = x >= -4096 && x < 4096
|
||||
|
@ -1,7 +1,7 @@
|
||||
functionName
|
||||
:: ( C1
|
||||
, C2
|
||||
, C3
|
||||
:: ( C1,
|
||||
C2,
|
||||
C3
|
||||
)
|
||||
=> a
|
||||
-> b
|
||||
|
@ -1,6 +1,6 @@
|
||||
foo, bar :: Int
|
||||
|
||||
foo
|
||||
, bar
|
||||
, baz
|
||||
foo,
|
||||
bar,
|
||||
baz
|
||||
:: Int
|
||||
|
@ -8,8 +8,8 @@ bar x =
|
||||
]
|
||||
|
||||
baz x =
|
||||
[ 1
|
||||
, 3
|
||||
[ 1,
|
||||
3
|
||||
.. x
|
||||
]
|
||||
|
||||
|
@ -4,15 +4,15 @@ foo x = proc a -> a -< x
|
||||
|
||||
bar f x =
|
||||
proc
|
||||
( y
|
||||
, z
|
||||
, w
|
||||
( y,
|
||||
z,
|
||||
w
|
||||
)
|
||||
->
|
||||
f -< -- The value
|
||||
( x -- Foo
|
||||
, w -- Bar
|
||||
, z -- Baz
|
||||
( x, -- Foo
|
||||
w, -- Bar
|
||||
z -- Baz
|
||||
)
|
||||
|
||||
baz x = proc a -> a -<< x
|
||||
|
@ -5,8 +5,8 @@ foo f = proc a -> case a of Left b -> f -< b
|
||||
bar f g h j =
|
||||
proc a -> case a of
|
||||
Left
|
||||
( (a, b)
|
||||
, (c, d)
|
||||
( (a, b),
|
||||
(c, d)
|
||||
) -> f (a <> c) -< b <> d
|
||||
Right
|
||||
(Left a) ->
|
||||
|
@ -6,29 +6,29 @@ foo
|
||||
h
|
||||
ma =
|
||||
proc
|
||||
( (a, b)
|
||||
, (c, d)
|
||||
, (e, f)
|
||||
( (a, b),
|
||||
(c, d),
|
||||
(e, f)
|
||||
)
|
||||
-> do
|
||||
-- Begin do
|
||||
(x, y) <- -- GHC parser fails if layed out over multiple lines
|
||||
f -- Call into f
|
||||
( a
|
||||
, c -- Tuple together arguments
|
||||
( a,
|
||||
c -- Tuple together arguments
|
||||
)
|
||||
( b
|
||||
, d
|
||||
( b,
|
||||
d
|
||||
) -<
|
||||
( b + 1 -- Funnel into arrow
|
||||
, d * b
|
||||
( b + 1, -- Funnel into arrow
|
||||
d * b
|
||||
)
|
||||
if x `mod` y == 0 -- Basic condition
|
||||
then
|
||||
case e of -- Only left case is relevant
|
||||
Left
|
||||
( z
|
||||
, w
|
||||
( z,
|
||||
w
|
||||
) -> \u -> -- Procs can have lambdas
|
||||
let v =
|
||||
u ^ -- Actually never used
|
||||
|
@ -28,9 +28,9 @@ bazbaz f g h = proc (a, b, c) -> do
|
||||
h
|
||||
x
|
||||
y -<
|
||||
( a
|
||||
, b
|
||||
, c
|
||||
( a,
|
||||
b,
|
||||
c
|
||||
)
|
||||
returnA -<
|
||||
(x, y, z)
|
||||
|
@ -6,8 +6,8 @@ foo f g = proc (x, y) -> do
|
||||
g x -<
|
||||
y
|
||||
bar -<
|
||||
( a
|
||||
, b
|
||||
( a,
|
||||
b
|
||||
)
|
||||
rec p <-
|
||||
f
|
||||
|
@ -0,0 +1,4 @@
|
||||
foo = do
|
||||
( bar
|
||||
baz
|
||||
)
|
@ -0,0 +1,2 @@
|
||||
foo = do (bar
|
||||
baz)
|
@ -7,8 +7,8 @@ sort = sortBy ?cmp
|
||||
|
||||
sort'
|
||||
:: ( ?cmp
|
||||
:: a -> a -> Bool
|
||||
, ?foo :: Int
|
||||
:: a -> a -> Bool,
|
||||
?foo :: Int
|
||||
)
|
||||
=> [a]
|
||||
-> [a]
|
||||
|
@ -5,21 +5,21 @@ bar x y = [(a, b) | a <- x, even a, b <- y, a != b]
|
||||
barbaz x y z w =
|
||||
[ (a, b, c, d) -- Foo
|
||||
| a <-
|
||||
x -- Bar
|
||||
, b <- y -- Baz
|
||||
, any even [a, b]
|
||||
, c <-
|
||||
x, -- Bar
|
||||
b <- y, -- Baz
|
||||
any even [a, b],
|
||||
c <-
|
||||
z *
|
||||
z ^
|
||||
2 -- Bar baz
|
||||
, d <-
|
||||
2, -- Bar baz
|
||||
d <-
|
||||
w +
|
||||
w -- Baz bar
|
||||
, all
|
||||
w, -- Baz bar
|
||||
all
|
||||
even
|
||||
[ a
|
||||
, b
|
||||
, c
|
||||
, d
|
||||
[ a,
|
||||
b,
|
||||
c,
|
||||
d
|
||||
]
|
||||
]
|
||||
|
@ -3,22 +3,22 @@ foo x y = [(a, b) | a <- x | b <- y]
|
||||
bar x y z w = [(a, b, c, d) | a <- x, b <- y, a `mod` b == 0 | c <- z | d <- w]
|
||||
|
||||
baz x y z w =
|
||||
[ ( a
|
||||
, b
|
||||
, c
|
||||
, d
|
||||
, e
|
||||
, f
|
||||
, g
|
||||
, h
|
||||
, i
|
||||
, j
|
||||
[ ( a,
|
||||
b,
|
||||
c,
|
||||
d,
|
||||
e,
|
||||
f,
|
||||
g,
|
||||
h,
|
||||
i,
|
||||
j
|
||||
)
|
||||
| a <- -- Foo 1
|
||||
x -- Foo 2
|
||||
, b <- -- Bar 1
|
||||
y -- Bar 2
|
||||
, a `mod`
|
||||
x, -- Foo 2
|
||||
b <- -- Bar 1
|
||||
y, -- Bar 2
|
||||
a `mod`
|
||||
b == -- Value
|
||||
0
|
||||
| c <- -- Baz 1
|
||||
@ -31,7 +31,7 @@ baz x y z w =
|
||||
| h <- z + z * w ^ 2 -- Bar foo
|
||||
| i <- -- Bar bar 1
|
||||
a + -- Bar bar 2
|
||||
b -- Bar bar 3
|
||||
, j <- -- Bar baz 1
|
||||
b, -- Bar bar 3
|
||||
j <- -- Bar baz 1
|
||||
a + b -- Bar baz 2
|
||||
]
|
||||
|
@ -0,0 +1,8 @@
|
||||
( getNodeSettingsR :<|>
|
||||
getNodeInfoR :<|>
|
||||
getNextUpdateR :<|>
|
||||
restartNodeR
|
||||
) :<|>
|
||||
( getUtxoR :<|>
|
||||
getConfirmedProposalsR
|
||||
) = client nodeV1Api
|
@ -0,0 +1,7 @@
|
||||
( getNodeSettingsR
|
||||
:<|> getNodeInfoR
|
||||
:<|> getNextUpdateR
|
||||
:<|> restartNodeR
|
||||
):<|>( getUtxoR
|
||||
:<|> getConfirmedProposalsR
|
||||
) = client nodeV1Api
|
@ -0,0 +1,15 @@
|
||||
readerBench doc name =
|
||||
runPure $ case (getReader name, getWriter name) of
|
||||
( Right (TextReader r, rexts),
|
||||
Right (TextWriter w, wexts)
|
||||
) -> undefined
|
||||
|
||||
f xs = case xs of
|
||||
[ a,
|
||||
b
|
||||
] -> a + b
|
||||
|
||||
g xs = case xs of
|
||||
( a :
|
||||
bs
|
||||
) -> a + b
|
@ -0,0 +1,12 @@
|
||||
readerBench doc name =
|
||||
runPure $ case (getReader name, getWriter name) of
|
||||
(Right (TextReader r, rexts),
|
||||
Right (TextWriter w, wexts)) -> undefined
|
||||
|
||||
f xs = case xs of
|
||||
[ a,
|
||||
b ] -> a + b
|
||||
|
||||
g xs = case xs of
|
||||
(a:
|
||||
bs) -> a + b
|
@ -13,7 +13,7 @@ baz Boom {boom = b, ..} = b
|
||||
quux :: Boom -> Int
|
||||
quux
|
||||
Boom
|
||||
{ boom = a
|
||||
, foom = b
|
||||
, ..
|
||||
{ boom = a,
|
||||
foom = b,
|
||||
..
|
||||
} = a + b
|
||||
|
@ -1,8 +1,8 @@
|
||||
foo = Foo {a = 3}
|
||||
|
||||
bar = Bar
|
||||
{ abc = foo
|
||||
, def = Foo {a = 10}
|
||||
{ abc = foo,
|
||||
def = Foo {a = 10}
|
||||
}
|
||||
|
||||
baz = Baz {}
|
||||
|
@ -2,8 +2,8 @@ foo x = x {a = 3}
|
||||
|
||||
bar x =
|
||||
x
|
||||
{ abc = foo
|
||||
, def = Foo {a = 10}
|
||||
{ abc = foo,
|
||||
def = Foo {a = 10}
|
||||
}
|
||||
|
||||
baz x = x {}
|
||||
|
@ -4,10 +4,10 @@
|
||||
foo x y = Foo {x, y}
|
||||
|
||||
bar x y z = Bar
|
||||
{ x
|
||||
, y
|
||||
, z
|
||||
, ..
|
||||
{ x,
|
||||
y,
|
||||
z,
|
||||
..
|
||||
}
|
||||
|
||||
baz = Baz {..}
|
||||
|
@ -6,9 +6,9 @@ foo = static 5
|
||||
bar :: StaticPtr [Int]
|
||||
bar =
|
||||
static
|
||||
[ 1
|
||||
, 2
|
||||
, 3
|
||||
[ 1,
|
||||
2,
|
||||
3
|
||||
]
|
||||
|
||||
baz :: StaticPtr Bool
|
||||
|
@ -3,24 +3,24 @@
|
||||
foo xs ys = [(x, y) | x <- xs, y <- ys, then reverse]
|
||||
|
||||
foo' xs ys =
|
||||
[ ( x
|
||||
, y
|
||||
[ ( x,
|
||||
y
|
||||
)
|
||||
| x <- xs
|
||||
, y <- ys
|
||||
, -- First comment
|
||||
| x <- xs,
|
||||
y <- ys,
|
||||
-- First comment
|
||||
then reverse -- Second comment
|
||||
]
|
||||
|
||||
bar xs ys = [(x, y) | x <- xs, y <- ys, then sortWith by (x + y)]
|
||||
|
||||
bar' xs ys =
|
||||
[ ( x
|
||||
, y
|
||||
[ ( x,
|
||||
y
|
||||
)
|
||||
| x <- xs
|
||||
, y <- ys
|
||||
, -- First comment
|
||||
| x <- xs,
|
||||
y <- ys,
|
||||
-- First comment
|
||||
then sortWith
|
||||
by
|
||||
( x +
|
||||
@ -31,24 +31,24 @@ bar' xs ys =
|
||||
baz xs ys = [(x, y) | x <- xs, y <- ys, then group using permutations]
|
||||
|
||||
baz' xs ys =
|
||||
[ ( x
|
||||
, y
|
||||
[ ( x,
|
||||
y
|
||||
)
|
||||
| x <- xs
|
||||
, y <- ys
|
||||
, -- First comment
|
||||
| x <- xs,
|
||||
y <- ys,
|
||||
-- First comment
|
||||
then group using permutations -- Second comment
|
||||
]
|
||||
|
||||
quux xs ys = [(x, y) | x <- xs, y <- ys, then group by (x + y) using groupWith]
|
||||
|
||||
quux' xs ys =
|
||||
[ ( x
|
||||
, y
|
||||
[ ( x,
|
||||
y
|
||||
)
|
||||
| x <- xs
|
||||
, y <- ys
|
||||
, -- First comment
|
||||
| x <- xs,
|
||||
y <- ys,
|
||||
-- First comment
|
||||
then group by
|
||||
( x +
|
||||
y
|
||||
|
@ -5,5 +5,4 @@ foo = (,2)
|
||||
bar = (,5,)
|
||||
|
||||
baz =
|
||||
( ,,5,6,7,,,
|
||||
)
|
||||
(,,5,6,7,,,)
|
||||
|
@ -1,7 +1,7 @@
|
||||
foo = (1, 2, 3)
|
||||
|
||||
bar =
|
||||
( 1
|
||||
, 2
|
||||
, 3
|
||||
( 1,
|
||||
2,
|
||||
3
|
||||
)
|
||||
|
@ -3,7 +3,7 @@
|
||||
foo = (# 1, 2, 3 #)
|
||||
|
||||
bar =
|
||||
(# 1
|
||||
, 2
|
||||
, 3
|
||||
(# 1,
|
||||
2,
|
||||
3
|
||||
#)
|
||||
|
@ -1,6 +1,6 @@
|
||||
x :: [Int]
|
||||
x =
|
||||
[ 1
|
||||
, 2
|
||||
, somethingSomething 3
|
||||
[ 1,
|
||||
2,
|
||||
somethingSomething 3
|
||||
]
|
||||
|
@ -1,8 +1,8 @@
|
||||
{-# WARNING
|
||||
test
|
||||
, foo
|
||||
[ "These are bad functions"
|
||||
, "Really bad!"
|
||||
test,
|
||||
foo
|
||||
[ "These are bad functions",
|
||||
"Really bad!"
|
||||
]
|
||||
#-}
|
||||
test :: IO ()
|
||||
|
@ -1,12 +1,12 @@
|
||||
import qualified MegaModule as M
|
||||
( (<<<)
|
||||
, (>>>)
|
||||
, Either
|
||||
, Maybe (Just, Nothing)
|
||||
, MaybeT (..)
|
||||
, Monad ((>>), (>>=), return)
|
||||
, MonadBaseControl
|
||||
, join
|
||||
, liftIO
|
||||
, void
|
||||
( (<<<),
|
||||
(>>>),
|
||||
Either,
|
||||
Maybe (Just, Nothing),
|
||||
MaybeT (..),
|
||||
Monad ((>>), (>>=), return),
|
||||
MonadBaseControl,
|
||||
join,
|
||||
liftIO,
|
||||
void
|
||||
)
|
||||
|
@ -1,6 +1,6 @@
|
||||
import qualified MegaModule as M
|
||||
( -- (1)
|
||||
(<<<) -- (2)
|
||||
, (>>>)
|
||||
, Either -- (3)
|
||||
(<<<), -- (2)
|
||||
(>>>),
|
||||
Either -- (3)
|
||||
)
|
||||
|
@ -1,11 +1,11 @@
|
||||
import A hiding
|
||||
( foobarbazqux
|
||||
, foobarbazqux
|
||||
, foobarbazqux
|
||||
, foobarbazqux
|
||||
, foobarbazqux
|
||||
, foobarbazqux
|
||||
, foobarbazqux
|
||||
( foobarbazqux,
|
||||
foobarbazqux,
|
||||
foobarbazqux,
|
||||
foobarbazqux,
|
||||
foobarbazqux,
|
||||
foobarbazqux,
|
||||
foobarbazqux
|
||||
)
|
||||
import {-# SOURCE #-} safe qualified Module as M hiding (a, b, c, d, e, f)
|
||||
import Name hiding ()
|
||||
|
@ -1,10 +1,10 @@
|
||||
import qualified MegaModule as M
|
||||
( (<<<)
|
||||
, (>>>)
|
||||
, Either
|
||||
, Monad
|
||||
( (>>)
|
||||
, (>>=)
|
||||
, return
|
||||
( (<<<),
|
||||
(>>>),
|
||||
Either,
|
||||
Monad
|
||||
( (>>),
|
||||
(>>=),
|
||||
return
|
||||
)
|
||||
)
|
||||
|
@ -1,9 +1,9 @@
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
|
||||
module ExportSyntax
|
||||
( A (.., NoA)
|
||||
, Q (F, ..)
|
||||
, G (T, .., U)
|
||||
( A (.., NoA),
|
||||
Q (F, ..),
|
||||
G (T, .., U)
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
module Foo
|
||||
( foo
|
||||
, bar
|
||||
, baz
|
||||
( foo,
|
||||
bar,
|
||||
baz
|
||||
)
|
||||
where
|
||||
|
@ -4,17 +4,17 @@
|
||||
-- | Header.
|
||||
module My.Module
|
||||
( -- * Something
|
||||
foo
|
||||
, bar
|
||||
, -- * Another thing
|
||||
(<?>)
|
||||
, {- some other thing -} foo2 -- yet another
|
||||
, foo3 -- third one
|
||||
, baz
|
||||
, bar2 -- a multiline comment
|
||||
foo,
|
||||
bar,
|
||||
-- * Another thing
|
||||
(<?>),
|
||||
{- some other thing -} foo2, -- yet another
|
||||
foo3, -- third one
|
||||
baz,
|
||||
bar2, -- a multiline comment
|
||||
-- the second line
|
||||
, bar3
|
||||
, module Foo.Bar.Baz
|
||||
bar3,
|
||||
module Foo.Bar.Baz
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -1,6 +1,6 @@
|
||||
module Foo
|
||||
( foo
|
||||
, bar
|
||||
, baz
|
||||
( foo,
|
||||
bar,
|
||||
baz
|
||||
)
|
||||
where
|
||||
|
@ -1,11 +1,11 @@
|
||||
module Test
|
||||
{-# DEPRECATED
|
||||
[ "This module is deprecated."
|
||||
, "Please use OtherModule instead."
|
||||
[ "This module is deprecated.",
|
||||
"Please use OtherModule instead."
|
||||
]
|
||||
#-}
|
||||
( foo
|
||||
, bar
|
||||
, baz
|
||||
( foo,
|
||||
bar,
|
||||
baz
|
||||
)
|
||||
where
|
||||
|
@ -1,7 +1,7 @@
|
||||
module Test {-# DEPRECATED "This module is unstable" #-}
|
||||
( foo
|
||||
, bar
|
||||
, baz
|
||||
( foo,
|
||||
bar,
|
||||
baz
|
||||
)
|
||||
where
|
||||
|
||||
|
@ -1,4 +1,4 @@
|
||||
[ foo
|
||||
, bar
|
||||
, baz
|
||||
]
|
||||
[ foo,
|
||||
bar,
|
||||
baz
|
||||
]
|
||||
|
@ -1,8 +1,8 @@
|
||||
[ foo
|
||||
, bar
|
||||
, foo
|
||||
[ foo,
|
||||
bar,
|
||||
foo
|
||||
:: ( Int
|
||||
-> Int
|
||||
)
|
||||
-> Bool
|
||||
]
|
||||
]
|
||||
|
@ -1,7 +1,7 @@
|
||||
module MyModule
|
||||
( R
|
||||
, runR
|
||||
, txt
|
||||
, blah
|
||||
( R,
|
||||
runR,
|
||||
txt,
|
||||
blah
|
||||
)
|
||||
where
|
||||
|
@ -17,18 +17,13 @@ module Ormolu.Printer.Combinators
|
||||
, newline
|
||||
, inci
|
||||
, located
|
||||
, locatedVia
|
||||
, located'
|
||||
, switchLayout
|
||||
, vlayout
|
||||
, breakpoint
|
||||
, breakpoint'
|
||||
-- ** Formatting lists
|
||||
, velt
|
||||
, velt'
|
||||
, withSep
|
||||
, spaceSep
|
||||
, newlineSep
|
||||
, sep
|
||||
-- ** Wrapping
|
||||
, sitcc
|
||||
, line
|
||||
@ -85,18 +80,7 @@ located
|
||||
=> Located a -- ^ Thing to enter
|
||||
-> (a -> R ()) -- ^ How to render inner value
|
||||
-> R ()
|
||||
located loc@(L l _) = locatedVia (Just l) loc
|
||||
|
||||
-- | A special version of 'located' that allows to control layout using an
|
||||
-- externally provided span. 'Nothing' means that layout won't be changed.
|
||||
|
||||
locatedVia
|
||||
:: Data a
|
||||
=> Maybe SrcSpan -- ^ Span that controls layout selection
|
||||
-> Located a -- ^ Thing to enter
|
||||
-> (a -> R ()) -- ^ How to render inner value
|
||||
-> R ()
|
||||
locatedVia ml loc f = do
|
||||
located loc f = do
|
||||
let withRealLocated (L l a) g =
|
||||
case l of
|
||||
UnhelpfulSpan _ -> return ()
|
||||
@ -109,9 +93,7 @@ locatedVia ml loc f = do
|
||||
if isModule (unLoc loc)
|
||||
then id
|
||||
else withEnclosingSpan orf
|
||||
setEnclosingSpan $ case ml of
|
||||
Nothing -> f (unLoc loc)
|
||||
Just l' -> switchLayout l' (f (unLoc loc))
|
||||
setEnclosingSpan $ switchLayout [getLoc loc] (f (unLoc loc))
|
||||
withRealLocated loc spitFollowingComments
|
||||
|
||||
-- | A version of 'located' with arguments flipped.
|
||||
@ -123,19 +105,28 @@ located'
|
||||
-> R ()
|
||||
located' = flip located
|
||||
|
||||
-- | Set layout according to given 'SrcSpan' for a given computation. Use
|
||||
-- this only when you need to set layout based on e.g. combined span of
|
||||
-- | Set layout according to combination of given 'SrcSpan's for a given.
|
||||
-- Use this only when you need to set layout based on e.g. combined span of
|
||||
-- several elements when there is no corresponding 'Located' wrapper
|
||||
-- provided by GHC AST. It is relatively rare that this one is needed.
|
||||
--
|
||||
-- Given empty list this function will set layout to single line.
|
||||
|
||||
switchLayout
|
||||
:: SrcSpan -- ^ Span that controls layout
|
||||
:: [SrcSpan] -- ^ Span that controls layout
|
||||
-> R () -- ^ Computation to run with changed layout
|
||||
-> R ()
|
||||
switchLayout spn = enterLayout
|
||||
(if isOneLineSpan spn
|
||||
switchLayout spans' = enterLayout (spansLayout spans')
|
||||
|
||||
-- | Which layout combined spans result in?
|
||||
|
||||
spansLayout :: [SrcSpan] -> Layout
|
||||
spansLayout = \case
|
||||
[] -> SingleLine
|
||||
(x:xs) ->
|
||||
if isOneLineSpan (foldr combineSrcSpans x xs)
|
||||
then SingleLine
|
||||
else MultiLine)
|
||||
else MultiLine
|
||||
|
||||
-- | Insert a space if enclosing layout is single-line, or newline if it's
|
||||
-- multiline.
|
||||
@ -156,56 +147,14 @@ breakpoint' = vlayout (return ()) newline
|
||||
----------------------------------------------------------------------------
|
||||
-- Formatting lists
|
||||
|
||||
-- | Element of variable layout. This means that the sub-components may be
|
||||
-- rendered either on single line or each on its own line depending on
|
||||
-- current layout.
|
||||
--
|
||||
-- This version does not make subsequent element (second and later) align
|
||||
-- with the first automatically and does not insert spaces between elements
|
||||
-- when layout is single line.
|
||||
-- | Render a collection of elements inserting a separator between them.
|
||||
|
||||
velt :: [R ()] -> R ()
|
||||
velt xs = sequence_ (intersperse breakpoint' (sitcc <$> xs))
|
||||
|
||||
-- | Like 'velt', but all sub-elements start at the same indentation level
|
||||
-- as first element, additionally spaces are inserted when layout is single
|
||||
-- line.
|
||||
|
||||
velt' :: [R ()] -> R ()
|
||||
velt' xs = sitcc $ sequence_ (intersperse breakpoint (sitcc <$> xs))
|
||||
|
||||
-- | Put separator between renderings of items of a list.
|
||||
|
||||
withSep
|
||||
sep
|
||||
:: R () -- ^ Separator
|
||||
-> (a -> R ()) -- ^ How to render list items
|
||||
-> [a] -- ^ List to render
|
||||
-> [R ()] -- ^ List of printing actions
|
||||
withSep sep f = \case
|
||||
[] -> []
|
||||
(x:xs) ->
|
||||
let g a = sep >> f a
|
||||
in f x : fmap g xs
|
||||
|
||||
-- | Render space-separated elements.
|
||||
--
|
||||
-- > spaceSep f = sequence_ . withSep space f
|
||||
|
||||
spaceSep
|
||||
:: (a -> R ()) -- ^ How to render list items
|
||||
-> [a] -- ^ List to render
|
||||
-> (a -> R ()) -- ^ How to render an element
|
||||
-> [a] -- ^ Elements to render
|
||||
-> R ()
|
||||
spaceSep f = sequence_ . withSep space f
|
||||
|
||||
-- | Render newline-separated elements.
|
||||
--
|
||||
-- > newlineSep f = sequence_ . withSep newline f
|
||||
|
||||
newlineSep
|
||||
:: (a -> R ()) -- ^ How to render list items
|
||||
-> [a] -- ^ List to render
|
||||
-> R ()
|
||||
newlineSep f = sequence_ . withSep newline f
|
||||
sep s f xs = sequence_ (intersperse s (f <$> xs))
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Wrapping
|
||||
@ -259,6 +208,7 @@ bracketsPar :: R () -> R ()
|
||||
bracketsPar m = sitcc $ do
|
||||
txt "[: "
|
||||
m
|
||||
vlayout (return ()) space
|
||||
txt " :]"
|
||||
|
||||
-- | Surround given entity by parentheses @(@ and @)@.
|
||||
@ -275,7 +225,7 @@ parensHash :: R () -> R ()
|
||||
parensHash m = sitcc $ do
|
||||
txt "(# "
|
||||
m
|
||||
breakpoint
|
||||
vlayout space (newline >> txt " ")
|
||||
txt "#)"
|
||||
|
||||
-- | Braces as used for pragmas: @{-#@ and @#-}@.
|
||||
@ -302,15 +252,19 @@ pragma pragmaText body = pragmaBraces $ do
|
||||
-- current layout is multiline.
|
||||
|
||||
ospaces :: R () -> R ()
|
||||
ospaces m = vlayout m (txt " " >> m >> newline)
|
||||
ospaces m = vlayout m $ do
|
||||
space
|
||||
m
|
||||
newline
|
||||
txt " "
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Literals
|
||||
|
||||
-- | Print @,@ followed by a space.
|
||||
-- | Print @,@.
|
||||
|
||||
comma :: R ()
|
||||
comma = txt ", "
|
||||
comma = txt ","
|
||||
|
||||
-- | Print single space.
|
||||
|
||||
|
@ -130,9 +130,9 @@ p_infixDefHelper isInfix inci' name args =
|
||||
inci' p1
|
||||
unless (null ps) . inci' $ do
|
||||
breakpoint
|
||||
velt' ps
|
||||
sitcc (sep breakpoint sitcc ps)
|
||||
(_, ps) -> do
|
||||
name
|
||||
unless (null ps) $ do
|
||||
breakpoint
|
||||
inci' (velt' args)
|
||||
inci' $ sitcc (sep breakpoint sitcc args)
|
||||
|
@ -21,7 +21,6 @@ import Ormolu.Printer.Meat.Common
|
||||
import Ormolu.Printer.Meat.Type
|
||||
import Ormolu.Utils
|
||||
import RdrName (RdrName (..))
|
||||
import SrcLoc (Located, combineSrcSpans)
|
||||
import {-# SOURCE #-} Ormolu.Printer.Meat.Declaration
|
||||
|
||||
p_classDecl
|
||||
@ -37,13 +36,10 @@ p_classDecl
|
||||
-> R ()
|
||||
p_classDecl ctx name tvars fixity fdeps csigs cdefs cats catdefs = do
|
||||
let HsQTvs {..} = tvars
|
||||
variableSpans = foldr (combineSrcSpans . getLoc) noSrcSpan hsq_explicit
|
||||
signatureSpans = getLoc name `combineSrcSpans` variableSpans
|
||||
dependencySpans = foldr (combineSrcSpans . getLoc) noSrcSpan fdeps
|
||||
combinedSpans =
|
||||
getLoc ctx `combineSrcSpans`
|
||||
signatureSpans `combineSrcSpans`
|
||||
dependencySpans
|
||||
variableSpans = getLoc <$> hsq_explicit
|
||||
signatureSpans = getLoc name : variableSpans
|
||||
dependencySpans = getLoc <$> fdeps
|
||||
combinedSpans = getLoc ctx : (signatureSpans ++ dependencySpans)
|
||||
txt "class"
|
||||
switchLayout combinedSpans $ do
|
||||
breakpoint
|
||||
@ -86,13 +82,13 @@ p_classFundeps :: [Located (FunDep (Located RdrName))] -> R ()
|
||||
p_classFundeps fdeps = unless (null fdeps) $ do
|
||||
breakpoint
|
||||
txt "| "
|
||||
velt $ withSep comma (located' p_funDep) fdeps
|
||||
sitcc $ sep (comma >> breakpoint) (sitcc . located' p_funDep) fdeps
|
||||
|
||||
p_funDep :: FunDep (Located RdrName) -> R ()
|
||||
p_funDep (before, after) = do
|
||||
spaceSep p_rdrName before
|
||||
sep space p_rdrName before
|
||||
txt " -> "
|
||||
spaceSep p_rdrName after
|
||||
sep space p_rdrName after
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Helpers
|
||||
|
@ -10,7 +10,6 @@ module Ormolu.Printer.Meat.Declaration.Data
|
||||
where
|
||||
|
||||
import Control.Monad
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Maybe (isJust)
|
||||
import GHC
|
||||
import Ormolu.Printer.Combinators
|
||||
@ -28,14 +27,13 @@ p_dataDecl
|
||||
-> HsDataDefn GhcPs -- ^ Data definition
|
||||
-> R ()
|
||||
p_dataDecl style name tpats fixity HsDataDefn {..} = do
|
||||
let combinedSpans = combineSrcSpans' (getLoc name :| (getLoc <$> tpats))
|
||||
txt $ case dd_ND of
|
||||
NewType -> "newtype"
|
||||
DataType -> "data"
|
||||
txt $ case style of
|
||||
Associated -> mempty
|
||||
Free -> " instance"
|
||||
switchLayout combinedSpans $ do
|
||||
switchLayout (getLoc name : fmap getLoc tpats) $ do
|
||||
breakpoint
|
||||
inci $ p_infixDefHelper
|
||||
(isInfix fixity)
|
||||
@ -54,13 +52,13 @@ p_dataDecl style name tpats fixity HsDataDefn {..} = do
|
||||
then do
|
||||
txt " where"
|
||||
newline
|
||||
inci $ newlineSep (sitcc . located' p_conDecl) dd_cons
|
||||
else switchLayout (combineSrcSpans' (getLoc name :| (getLoc <$> dd_cons))) $
|
||||
inci . sitcc $ sep newline (sitcc . located' p_conDecl) dd_cons
|
||||
else switchLayout (getLoc name : (getLoc <$> dd_cons)) $
|
||||
inci $ do
|
||||
breakpoint
|
||||
txt "= "
|
||||
let sep = vlayout (txt " | ") (txt "| ")
|
||||
velt $ withSep sep (sitcc . located' p_conDecl) dd_cons
|
||||
let s = vlayout (txt " | ") (newline >> txt "| ")
|
||||
sep s (sitcc . located' p_conDecl) dd_cons
|
||||
newline
|
||||
inci . located dd_derivs $ \xs ->
|
||||
forM_ xs (line . located' p_hsDerivingClause)
|
||||
@ -73,11 +71,10 @@ p_conDecl = \case
|
||||
[] -> return ()
|
||||
(c:cs) -> do
|
||||
p_rdrName c
|
||||
unless (null cs) $ do
|
||||
breakpoint'
|
||||
inci $ do
|
||||
unless (null cs) . inci $ do
|
||||
comma
|
||||
velt $ withSep comma p_rdrName cs
|
||||
breakpoint
|
||||
sitcc $ sep (comma >> breakpoint) p_rdrName cs
|
||||
breakpoint
|
||||
inci $ do
|
||||
txt ":: "
|
||||
@ -85,7 +82,7 @@ p_conDecl = \case
|
||||
forM_ con_mb_cxt p_lhsContext
|
||||
case con_args of
|
||||
PrefixCon xs -> do
|
||||
velt' (located' p_hsType <$> xs)
|
||||
sep breakpoint (located' p_hsType) xs
|
||||
unless (null xs) $ do
|
||||
breakpoint
|
||||
txt "-> "
|
||||
@ -95,7 +92,7 @@ p_conDecl = \case
|
||||
breakpoint
|
||||
txt "-> "
|
||||
InfixCon _ _ -> notImplemented "InfixCon"
|
||||
locatedVia Nothing con_res_ty p_hsType
|
||||
p_hsType (unLoc con_res_ty)
|
||||
ConDeclH98 {..} -> do
|
||||
p_forallBndrs con_ex_tvs
|
||||
forM_ con_mb_cxt p_lhsContext
|
||||
@ -103,7 +100,7 @@ p_conDecl = \case
|
||||
PrefixCon xs -> do
|
||||
p_rdrName con_name
|
||||
unless (null xs) breakpoint
|
||||
inci $ velt' (located' p_hsType <$> xs)
|
||||
inci . sitcc $ sep breakpoint (sitcc . located' p_hsType) xs
|
||||
RecCon l -> do
|
||||
p_rdrName con_name
|
||||
breakpoint
|
||||
@ -124,7 +121,7 @@ p_forallBndrs = \case
|
||||
[] -> return ()
|
||||
bndrs -> do
|
||||
txt "forall "
|
||||
spaceSep (located' p_hsTyVarBndr) bndrs
|
||||
sep space (located' p_hsTyVarBndr) bndrs
|
||||
txt ". "
|
||||
|
||||
p_lhsContext
|
||||
@ -150,12 +147,15 @@ p_hsDerivingClause HsDerivingClause {..} = do
|
||||
txt "deriving"
|
||||
let derivingWhat = located deriv_clause_tys $ \case
|
||||
[] -> txt "()"
|
||||
xs -> parens . velt $ withSep comma (located' p_hsType . hsib_body) xs
|
||||
xs -> parens . sitcc $ sep
|
||||
(comma >> breakpoint)
|
||||
(sitcc . located' p_hsType . hsib_body)
|
||||
xs
|
||||
case deriv_clause_strategy of
|
||||
Nothing -> do
|
||||
breakpoint
|
||||
inci derivingWhat
|
||||
Just l -> locatedVia Nothing l $ \case
|
||||
Just (L _ a) -> case a of
|
||||
StockStrategy -> do
|
||||
txt " stock"
|
||||
breakpoint
|
||||
|
@ -16,6 +16,6 @@ p_defaultDecl = \case
|
||||
DefaultDecl NoExt ts -> line $ do
|
||||
txt "default"
|
||||
breakpoint
|
||||
inci . parens . velt $
|
||||
withSep comma (located' p_hsType) ts
|
||||
inci . parens . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_hsType) ts
|
||||
XDefaultDecl {} -> notImplemented "XDefaultDecl"
|
||||
|
@ -35,7 +35,7 @@ p_foreignTypeSig fd = do
|
||||
breakpoint
|
||||
-- Switch into the layout of the signature, to allow us to pull name and
|
||||
-- signature onto a single line.
|
||||
inci . switchLayout (getLoc . hsib_body $ fd_sig_ty fd) $ do
|
||||
inci . switchLayout [getLoc . hsib_body $ fd_sig_ty fd] $ do
|
||||
p_rdrName (fd_name fd)
|
||||
p_typeAscription (HsWC NoExt (fd_sig_ty fd))
|
||||
|
||||
|
@ -41,7 +41,7 @@ p_standaloneDerivDecl DerivDecl {..} = do
|
||||
Nothing -> do
|
||||
space
|
||||
instTypes False
|
||||
Just l -> locatedVia Nothing l $ \case
|
||||
Just (L _ a) -> case a of
|
||||
StockStrategy -> do
|
||||
txt " stock "
|
||||
instTypes False
|
||||
@ -72,7 +72,6 @@ p_clsInstDecl = \case
|
||||
inci $ do
|
||||
match_overlap_mode cid_overlap_mode breakpoint
|
||||
p_hsType x
|
||||
XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
|
||||
-- GHC's AST does not necessarily store each kind of element in source
|
||||
-- location order. This happens because different declarations are stored in
|
||||
-- different lists. Consequently, to get all the declarations in proper
|
||||
@ -88,13 +87,16 @@ p_clsInstDecl = \case
|
||||
allDecls =
|
||||
snd <$>
|
||||
sortBy (comparing fst) (sigs <> vals <> tyFamInsts <> dataFamInsts)
|
||||
if not (null allDecls)
|
||||
then do
|
||||
txt " where"
|
||||
if null allDecls
|
||||
then newline
|
||||
else do
|
||||
switchLayout [getLoc hsib_body] breakpoint
|
||||
inci $ do
|
||||
txt "where"
|
||||
newline -- Ensure line is added after where clause.
|
||||
newline -- Add newline before first declaration.
|
||||
inci (p_hsDecls Associated allDecls)
|
||||
else newline
|
||||
p_hsDecls Associated allDecls
|
||||
XHsImplicitBndrs NoExt -> notImplemented "XHsImplicitBndrs"
|
||||
XClsInstDecl NoExt -> notImplemented "XClsInstDecl"
|
||||
|
||||
p_tyFamInstDecl :: FamilyStyle -> TyFamInstDecl GhcPs -> R ()
|
||||
|
@ -32,7 +32,7 @@ p_roleAnnot' l_name anns = line $ do
|
||||
breakpoint
|
||||
let
|
||||
p_role' = maybe (txt "_") p_role
|
||||
inci $ velt' $ (located' p_role') <$> anns
|
||||
inci . sitcc $ sep breakpoint (sitcc . located' p_role') anns
|
||||
|
||||
p_role :: Role -> R ()
|
||||
p_role = \case
|
||||
|
@ -16,13 +16,12 @@ import Ormolu.Printer.Meat.Common
|
||||
import Ormolu.Printer.Meat.Declaration.Signature
|
||||
import Ormolu.Printer.Meat.Declaration.Value
|
||||
import Ormolu.Utils
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Text as T
|
||||
|
||||
p_ruleDecls :: RuleDecls GhcPs -> R ()
|
||||
p_ruleDecls = \case
|
||||
HsRules NoExt _ xs -> line $ pragma "RULES" $
|
||||
velt' $ (located' p_ruleDecl) <$> xs
|
||||
HsRules NoExt _ xs -> line . pragma "RULES" . sitcc $
|
||||
sep breakpoint (sitcc . located' p_ruleDecl) xs
|
||||
XRuleDecls NoExt -> notImplemented "XRuleDecls"
|
||||
|
||||
p_ruleDecl :: RuleDecl GhcPs -> R ()
|
||||
@ -50,13 +49,13 @@ p_ruleName (_, name) = do
|
||||
txt "\""
|
||||
|
||||
p_ruleBndrs :: [LRuleBndr GhcPs] -> R ()
|
||||
p_ruleBndrs [] = return ()
|
||||
p_ruleBndrs bndrs =
|
||||
forM_ (NE.nonEmpty bndrs) $ \bndrs_ne ->
|
||||
switchLayout (combineSrcSpans' (getLoc <$> bndrs_ne)) $ do
|
||||
switchLayout (getLoc <$> bndrs) $ do
|
||||
txt "forall"
|
||||
breakpoint
|
||||
inci $ do
|
||||
velt' (located' p_ruleBndr <$> bndrs)
|
||||
sitcc $ sep breakpoint (sitcc . located' p_ruleBndr) bndrs
|
||||
txt "."
|
||||
|
||||
p_ruleBndr :: RuleBndr GhcPs -> R ()
|
||||
|
@ -49,9 +49,9 @@ p_typeSig (n:ns) hswc = do
|
||||
if null ns
|
||||
then p_typeAscription hswc
|
||||
else inci $ do
|
||||
vlayout (return ()) newline
|
||||
comma
|
||||
velt (withSep comma p_rdrName ns)
|
||||
breakpoint
|
||||
sep (comma >> breakpoint) p_rdrName ns
|
||||
p_typeAscription hswc
|
||||
|
||||
p_typeAscription
|
||||
@ -93,7 +93,7 @@ p_fixSig = \case
|
||||
space
|
||||
atom n
|
||||
space
|
||||
sequence_ (withSep comma p_rdrName names)
|
||||
sitcc $ sep (comma >> breakpoint) p_rdrName names
|
||||
XFixitySig NoExt -> notImplemented "XFixitySig"
|
||||
|
||||
p_inlineSig
|
||||
@ -125,7 +125,7 @@ p_specSig name ts InlinePragma {..} = pragmaBraces $ do
|
||||
breakpoint
|
||||
inci $ do
|
||||
txt ":: "
|
||||
velt (withSep comma (located' p_hsType) (hsib_body <$> ts))
|
||||
sep (comma >> breakpoint) (located' p_hsType . hsib_body) ts
|
||||
|
||||
p_activation :: Activation -> R ()
|
||||
p_activation = \case
|
||||
@ -162,10 +162,12 @@ p_booleanFormula
|
||||
-> R ()
|
||||
p_booleanFormula = \case
|
||||
Var name -> p_rdrName name
|
||||
And xs -> velt $
|
||||
withSep comma (located' p_booleanFormula) xs
|
||||
Or xs -> velt $
|
||||
withSep (vlayout space (return ()) >> txt "| ")
|
||||
And xs -> sitcc $ sep
|
||||
(comma >> breakpoint)
|
||||
(located' p_booleanFormula)
|
||||
xs
|
||||
Or xs -> sitcc $ sep
|
||||
(breakpoint >> txt "| ")
|
||||
(located' p_booleanFormula)
|
||||
xs
|
||||
Parens l -> located l (parens . p_booleanFormula)
|
||||
@ -177,7 +179,7 @@ p_completeSig
|
||||
p_completeSig cs' mty =
|
||||
located cs' $ \cs ->
|
||||
pragma "COMPLETE" . inci $ do
|
||||
velt (withSep comma p_rdrName cs)
|
||||
sitcc $ sep (comma >> breakpoint) p_rdrName cs
|
||||
forM_ mty $ \ty -> do
|
||||
breakpoint
|
||||
inci $ do
|
||||
|
@ -26,6 +26,6 @@ p_synDecl name tvars t = line $ do
|
||||
p_rdrName name
|
||||
let HsQTvs {..} = tvars
|
||||
unless (null hsq_explicit) space
|
||||
spaceSep (located' p_hsTyVarBndr) hsq_explicit
|
||||
sep space (located' p_hsTyVarBndr) hsq_explicit
|
||||
breakpoint
|
||||
inci (txt "= " >> located t p_hsType)
|
||||
|
@ -12,7 +12,6 @@ where
|
||||
|
||||
import BasicTypes (LexicalFixity (..))
|
||||
import Control.Monad
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Maybe (isNothing, isJust)
|
||||
import GHC
|
||||
import Ormolu.Printer.Combinators
|
||||
@ -31,11 +30,9 @@ p_famDecl style FamilyDecl {..} = do
|
||||
Associated -> mempty
|
||||
Free -> " family"
|
||||
let HsQTvs {..} = fdTyVars
|
||||
combinedSpans = combineSrcSpans' $
|
||||
getLoc fdLName :| fmap getLoc hsq_explicit
|
||||
breakpoint
|
||||
inci $ do
|
||||
switchLayout combinedSpans $ do
|
||||
switchLayout (getLoc fdLName : (getLoc <$> hsq_explicit)) $ do
|
||||
p_infixDefHelper
|
||||
(isInfix fdFixity)
|
||||
inci
|
||||
@ -82,14 +79,12 @@ p_injectivityAnn (InjectivityAnn a bs) = do
|
||||
p_rdrName a
|
||||
space
|
||||
txt "-> "
|
||||
spaceSep p_rdrName bs
|
||||
sep space p_rdrName bs
|
||||
|
||||
p_tyFamInstEqn :: TyFamInstEqn GhcPs -> R ()
|
||||
p_tyFamInstEqn HsIB {..} = do
|
||||
let FamEqn {..} = hsib_body
|
||||
combinedSpans = combineSrcSpans' $
|
||||
getLoc feqn_tycon :| fmap getLoc feqn_pats
|
||||
switchLayout combinedSpans $ p_infixDefHelper
|
||||
switchLayout (getLoc feqn_tycon : (getLoc <$> feqn_pats)) $ p_infixDefHelper
|
||||
(isInfix feqn_fixity)
|
||||
inci
|
||||
(p_rdrName feqn_tycon)
|
||||
|
@ -85,9 +85,9 @@ p_matchGroup'
|
||||
-> MatchGroup GhcPs (Located body)
|
||||
-> R ()
|
||||
p_matchGroup' placer pretty style MG {..} =
|
||||
locatedVia Nothing mg_alts $
|
||||
newlineSep (located' (\m@Match {..} ->
|
||||
sep newline (located' (\m@Match {..} ->
|
||||
p_match' placer pretty style (isInfixMatch m) (matchStrictness m) m_pats m_grhss))
|
||||
(unLoc mg_alts)
|
||||
p_matchGroup' _ _ _ (XMatchGroup NoExt) = notImplemented "XMatchGroup"
|
||||
|
||||
matchStrictness :: Match id body -> SrcStrictness
|
||||
@ -137,8 +137,8 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
|
||||
inci' = if isOneLineSpan combinedSpans
|
||||
then id
|
||||
else inci
|
||||
switchLayout combinedSpans $ do
|
||||
let stdCase = velt' (located' p_pat <$> m_pats)
|
||||
switchLayout [combinedSpans] $ do
|
||||
let stdCase = sep breakpoint (located' p_pat) m_pats
|
||||
case style of
|
||||
Function name ->
|
||||
p_infixDefHelper
|
||||
@ -201,12 +201,12 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
|
||||
if isCase style && hasGuards
|
||||
then RightArrow
|
||||
else EqualSign
|
||||
newlineSep (located' (p_grhs' pretty groupStyle)) grhssGRHSs
|
||||
sep newline (located' (p_grhs' pretty groupStyle)) grhssGRHSs
|
||||
let whereLocation = combineSrcSpans patGrhssSpan $ getLoc grhssLocalBinds
|
||||
whereIsEmpty = GHC.isEmptyLocalBindsPR (unLoc grhssLocalBinds)
|
||||
unless (GHC.eqEmptyLocalBinds (unLoc grhssLocalBinds))
|
||||
. inciLocalBinds
|
||||
. switchLayout whereLocation $ do
|
||||
. switchLayout [whereLocation] $ do
|
||||
if whereIsEmpty then newline else breakpoint
|
||||
txt "where"
|
||||
unless whereIsEmpty $ do
|
||||
@ -214,8 +214,8 @@ p_match' placer pretty style isInfix strictness m_pats m_grhss = do
|
||||
inci (located grhssLocalBinds p_hsLocalBinds)
|
||||
case style of
|
||||
Lambda -> placeHanging placement $
|
||||
switchLayout patGrhssSpan p_body
|
||||
_ -> switchLayout patGrhssSpan $
|
||||
switchLayout [patGrhssSpan] p_body
|
||||
_ -> switchLayout [patGrhssSpan] $
|
||||
placeHanging placement p_body
|
||||
|
||||
p_grhs :: GroupStyle -> GRHS GhcPs (LHsExpr GhcPs) -> R ()
|
||||
@ -232,7 +232,7 @@ p_grhs' pretty style (GRHS NoExt guards body) =
|
||||
[] -> p_body
|
||||
xs -> do
|
||||
txt "| "
|
||||
velt $ withSep comma (located' p_stmt) xs
|
||||
sitcc (sep (comma >> breakpoint) (sitcc . located' p_stmt) xs)
|
||||
space
|
||||
txt $ case style of
|
||||
EqualSign -> "="
|
||||
@ -298,7 +298,7 @@ p_hsCmd = \case
|
||||
HsCmdDo NoExt es -> do
|
||||
txt "do"
|
||||
newline
|
||||
inci (located es (newlineSep (located' (sitcc . p_stmt' p_hsCmd))))
|
||||
inci (located es (sitcc . sep newline (located' (sitcc . p_stmt' p_hsCmd))))
|
||||
HsCmdWrap {} -> notImplemented "HsCmdWrap"
|
||||
XCmd {} -> notImplemented "XCmd"
|
||||
|
||||
@ -368,7 +368,7 @@ p_stmt' pretty = \case
|
||||
inci (p_hsExpr x)
|
||||
RecStmt {..} -> do
|
||||
txt "rec "
|
||||
sitcc $ newlineSep (located' (p_stmt' pretty)) recS_stmts
|
||||
sitcc $ sep newline (located' (p_stmt' pretty)) recS_stmts
|
||||
XStmtLR {} -> notImplemented "XStmtLR"
|
||||
|
||||
gatherStmt :: ExprLStmt GhcPs -> [[ExprLStmt GhcPs]]
|
||||
@ -393,7 +393,7 @@ p_hsLocalBinds = \case
|
||||
(Left <$> bagToList bag) ++ (Right <$> lsigs)
|
||||
p_item (Left x) = located x p_valDecl'
|
||||
p_item (Right x) = located x p_sigDecl'
|
||||
newlineSep (sitcc . p_item) (sortOn ssStart items)
|
||||
sitcc $ sep newline (sitcc . p_item) (sortOn ssStart items)
|
||||
HsValBinds NoExt _ -> notImplemented "HsValBinds"
|
||||
HsIPBinds NoExt _ -> notImplemented "HsIPBinds"
|
||||
EmptyLocalBinds NoExt -> return ()
|
||||
@ -439,7 +439,7 @@ p_hsExpr = \case
|
||||
txt "\\case"
|
||||
newline
|
||||
inci (p_matchGroup LambdaCase mgroup)
|
||||
HsApp NoExt f x -> do
|
||||
HsApp NoExt f x -> sitcc $ do
|
||||
located f p_hsExpr
|
||||
breakpoint
|
||||
inci (located x p_hsExpr)
|
||||
@ -479,9 +479,11 @@ p_hsExpr = \case
|
||||
case boxity of
|
||||
Boxed -> parens
|
||||
Unboxed -> parensHash
|
||||
parens' $ if isSection
|
||||
then sequence_ (withSep (txt ",") (located' p_hsTupArg) args)
|
||||
else velt (withSep comma (located' p_hsTupArg) args)
|
||||
if isSection
|
||||
then switchLayout [] . parens' $
|
||||
sep comma (located' p_hsTupArg) args
|
||||
else switchLayout (getLoc <$> args) . parens' . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_hsTupArg) args
|
||||
ExplicitSum NoExt tag arity e -> do
|
||||
let before = tag - 1
|
||||
after = arity - before - 1
|
||||
@ -496,7 +498,7 @@ p_hsExpr = \case
|
||||
unless isFirst space
|
||||
located l p_hsExpr
|
||||
unless isLast space
|
||||
parensHash $ sequence_ (withSep (txt "|") f (zip args [0..]))
|
||||
parensHash $ sep (txt "|") f (zip args [0..])
|
||||
HsCase NoExt e mgroup -> do
|
||||
txt "case "
|
||||
located e p_hsExpr
|
||||
@ -518,7 +520,7 @@ p_hsExpr = \case
|
||||
inci (p_hsExpr x)
|
||||
HsMultiIf NoExt guards -> do
|
||||
txt "if "
|
||||
sitcc $ newlineSep (located' (p_grhs RightArrow)) guards
|
||||
sitcc $ sep newline (located' (p_grhs RightArrow)) guards
|
||||
HsLet NoExt localBinds e -> do
|
||||
txt "let "
|
||||
sitcc (located localBinds p_hsLocalBinds)
|
||||
@ -529,16 +531,14 @@ p_hsExpr = \case
|
||||
let doBody header = do
|
||||
txt header
|
||||
newline
|
||||
inci $ located es (newlineSep (located' (sitcc . p_stmt)))
|
||||
compBody = brackets $ located es $ \xs -> do
|
||||
let p_parBody =
|
||||
sequence_ .
|
||||
intersperse breakpoint .
|
||||
withSep (txt "| ") p_seqBody
|
||||
p_seqBody =
|
||||
sequence_ .
|
||||
intersperse (vlayout (pure ()) newline) .
|
||||
withSep comma (located' (sitcc . p_stmt))
|
||||
inci $ located es (sep newline (located' (sitcc . p_stmt)))
|
||||
compBody = brackets $ located es $ \xs -> do
|
||||
let p_parBody = sitcc . sep
|
||||
(breakpoint >> txt "| ")
|
||||
p_seqBody
|
||||
p_seqBody = sitcc . sep
|
||||
(comma >> breakpoint)
|
||||
(located' (sitcc . p_stmt))
|
||||
stmts = init xs
|
||||
yield = last xs
|
||||
lists = foldr (liftAppend . gatherStmt) [] stmts
|
||||
@ -557,7 +557,7 @@ p_hsExpr = \case
|
||||
ParStmtCtxt _ -> notImplemented "ParStmtCtxt"
|
||||
TransStmtCtxt _ -> notImplemented "TransStmtCtxt"
|
||||
ExplicitList _ _ xs ->
|
||||
brackets $ velt (withSep comma (located' p_hsExpr) xs)
|
||||
brackets . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsExpr) xs
|
||||
RecordCon {..} -> do
|
||||
located rcon_con_name atom
|
||||
breakpoint
|
||||
@ -567,11 +567,12 @@ p_hsExpr = \case
|
||||
case rec_dotdot of
|
||||
Just {} -> [txt ".."]
|
||||
Nothing -> []
|
||||
inci $ braces $ velt (withSep comma id (fields <> dotdot))
|
||||
inci . braces . sitcc $ sep (comma >> breakpoint) sitcc (fields <> dotdot)
|
||||
RecordUpd {..} -> do
|
||||
located rupd_expr p_hsExpr
|
||||
breakpoint
|
||||
inci $ braces $ velt (withSep comma (located' p_hsRecField) rupd_flds)
|
||||
inci . braces . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_hsRecField) rupd_flds
|
||||
ExprWithTySig affix x -> sitcc $ do
|
||||
located x p_hsExpr
|
||||
breakpoint
|
||||
@ -582,21 +583,21 @@ p_hsExpr = \case
|
||||
located hsib_body p_hsType
|
||||
ArithSeq NoExt _ x -> do
|
||||
case x of
|
||||
From from -> brackets $ do
|
||||
From from -> brackets . sitcc $ do
|
||||
located from p_hsExpr
|
||||
breakpoint
|
||||
txt ".."
|
||||
FromThen from next -> brackets $ do
|
||||
velt (withSep comma (located' p_hsExpr) [from, next])
|
||||
FromThen from next -> brackets . sitcc $ do
|
||||
sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
|
||||
breakpoint
|
||||
txt ".."
|
||||
FromTo from to -> brackets $ do
|
||||
FromTo from to -> brackets . sitcc $ do
|
||||
located from p_hsExpr
|
||||
breakpoint
|
||||
txt ".. "
|
||||
located to p_hsExpr
|
||||
FromThenTo from next to -> brackets $ do
|
||||
velt (withSep comma (located' p_hsExpr) [from, next])
|
||||
FromThenTo from next to -> brackets . sitcc $ do
|
||||
sitcc $ sep (comma >> breakpoint) (located' p_hsExpr) [from, next]
|
||||
breakpoint
|
||||
txt ".. "
|
||||
located to p_hsExpr
|
||||
@ -680,9 +681,9 @@ p_patSynBind (XPatSynBind NoExt) = notImplemented "XPatSynBind"
|
||||
p_patSynDetails :: HsPatSynDetails (Located RdrName) -> R ()
|
||||
p_patSynDetails = \case
|
||||
PrefixCon xs ->
|
||||
velt' (p_rdrName <$> xs)
|
||||
sitcc $ sep breakpoint p_rdrName xs
|
||||
RecCon xs ->
|
||||
velt' (p_rdrName . recordPatSynPatVar <$> xs)
|
||||
sitcc $ sep breakpoint (p_rdrName . recordPatSynPatVar) xs
|
||||
InfixCon _ _ -> notImplemented "InfixCon"
|
||||
|
||||
p_pat :: Pat GhcPs -> R ()
|
||||
@ -702,13 +703,13 @@ p_pat = \case
|
||||
txt "!"
|
||||
located pat p_pat
|
||||
ListPat NoExt pats -> do
|
||||
brackets $ velt (withSep comma (located' p_pat) pats)
|
||||
brackets . sitcc $ sep (comma >> breakpoint) (located' p_pat) pats
|
||||
TuplePat NoExt pats boxing -> do
|
||||
let f =
|
||||
case boxing of
|
||||
Boxed -> parens
|
||||
Unboxed -> parensHash
|
||||
f $ velt (withSep comma (located' p_pat) pats)
|
||||
f . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_pat) pats
|
||||
SumPat NoExt pat _ _ -> do
|
||||
-- XXX I'm not sure about this one.
|
||||
located pat p_pat
|
||||
@ -718,14 +719,14 @@ p_pat = \case
|
||||
p_rdrName pat
|
||||
unless (null xs) $ do
|
||||
breakpoint
|
||||
inci $ velt' (located' p_pat <$> xs)
|
||||
inci . sitcc $ sep breakpoint (sitcc . located' p_pat) xs
|
||||
RecCon (HsRecFields fields dotdot) -> do
|
||||
p_rdrName pat
|
||||
breakpoint
|
||||
let f = \case
|
||||
Nothing -> txt ".."
|
||||
Just x -> located x p_pat_hsRecField
|
||||
inci . braces . velt . withSep comma f $ case dotdot of
|
||||
inci . braces . sitcc . sep (comma >> breakpoint) f $ case dotdot of
|
||||
Nothing -> Just <$> fields
|
||||
Just n -> (Just <$> take n fields) ++ [Nothing]
|
||||
InfixCon x y -> do
|
||||
@ -899,7 +900,7 @@ exprPlacement = \case
|
||||
RecordCon NoExt _ _ -> Hanging
|
||||
HsProc NoExt (L s _) _ ->
|
||||
-- Indentation breaks if pattern is longer than one line and left hanging.
|
||||
-- Consequentally, once apply hanging when it is safe.
|
||||
-- Consequently, only apply hanging when it is safe.
|
||||
if isOneLineSpan s
|
||||
then Hanging
|
||||
else Normal
|
||||
|
@ -9,13 +9,11 @@ where
|
||||
|
||||
import BasicTypes
|
||||
import Data.Foldable
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.Text (Text)
|
||||
import GHC
|
||||
import Ormolu.Printer.Combinators
|
||||
import Ormolu.Printer.Meat.Common
|
||||
import Ormolu.Utils
|
||||
import SrcLoc (combineSrcSpans)
|
||||
|
||||
p_warnDecls :: WarnDecls GhcPs -> R ()
|
||||
p_warnDecls (Warnings NoExt _ warnings) =
|
||||
@ -30,16 +28,16 @@ p_warnDecl XWarnDecl {} = notImplemented "XWarnDecl"
|
||||
p_moduleWarning :: WarningTxt -> R ()
|
||||
p_moduleWarning wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (listSpan lits) $ do
|
||||
switchLayout (getLoc <$> lits) $ do
|
||||
breakpoint
|
||||
inci $ pragma pragmaText (inci $ p_lits lits)
|
||||
|
||||
p_topLevelWarning :: [Located RdrName] -> WarningTxt -> R ()
|
||||
p_topLevelWarning fnames wtxt = do
|
||||
let (pragmaText, lits) = warningText wtxt
|
||||
switchLayout (combineSrcSpans (listSpan fnames) (listSpan lits)) $ do
|
||||
switchLayout (fmap getLoc fnames ++ fmap getLoc lits) $ do
|
||||
pragma pragmaText . inci $ do
|
||||
velt (withSep comma p_rdrName fnames)
|
||||
sitcc $ sep (comma >> breakpoint) p_rdrName fnames
|
||||
breakpoint
|
||||
p_lits lits
|
||||
|
||||
@ -48,10 +46,7 @@ warningText = \case
|
||||
WarningTxt _ lits -> ("WARNING", lits)
|
||||
DeprecatedTxt _ lits -> ("DEPRECATED", lits)
|
||||
|
||||
listSpan :: [Located a] -> SrcSpan
|
||||
listSpan xs = combineSrcSpans' (getLoc <$> NE.fromList xs)
|
||||
|
||||
p_lits :: [Located StringLiteral] -> R ()
|
||||
p_lits = \case
|
||||
[l] -> atom l
|
||||
ls -> brackets . velt $ withSep comma atom ls
|
||||
ls -> brackets . sitcc $ sep (comma >> breakpoint) atom ls
|
||||
|
@ -23,7 +23,7 @@ p_hsmodExports [] = do
|
||||
breakpoint'
|
||||
txt ")"
|
||||
p_hsmodExports xs =
|
||||
parens . velt $ withSep comma (sitcc . located' p_lie) xs
|
||||
parens . sitcc $ sep (comma >> breakpoint) (sitcc . located' p_lie) xs
|
||||
|
||||
p_hsmodImport :: ImportDecl GhcPs -> R ()
|
||||
p_hsmodImport ImportDecl {..} = line $ do
|
||||
@ -52,10 +52,10 @@ p_hsmodImport ImportDecl {..} = line $ do
|
||||
txt " hiding"
|
||||
case ideclHiding of
|
||||
Nothing -> return ()
|
||||
Just (_, l) -> do
|
||||
Just (_, (L _ a)) -> do
|
||||
breakpoint
|
||||
inci . locatedVia Nothing l $
|
||||
parens . velt . withSep comma (located' p_lie)
|
||||
inci . parens . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_lie) a
|
||||
p_hsmodImport (XImportDecl NoExt) = notImplemented "XImportDecl"
|
||||
|
||||
p_lie :: IE GhcPs -> R ()
|
||||
@ -72,7 +72,7 @@ p_lie = \case
|
||||
inci $ do
|
||||
let names :: [R ()]
|
||||
names = located' p_ieWrappedName <$> xs
|
||||
parens . velt . withSep comma id $
|
||||
parens . sitcc . sep (comma >> breakpoint) sitcc $
|
||||
case w of
|
||||
NoIEWildcard -> names
|
||||
IEWildcard n ->
|
||||
|
@ -20,18 +20,16 @@ import Ormolu.Printer.Meat.Declaration
|
||||
import Ormolu.Printer.Meat.Declaration.Warning
|
||||
import Ormolu.Printer.Meat.ImportExport
|
||||
import Ormolu.Printer.Meat.LanguagePragma
|
||||
import SrcLoc (combineSrcSpans)
|
||||
|
||||
p_hsModule :: Set String -> ParsedSource -> R ()
|
||||
p_hsModule exts loc@(L moduleSpan hsModule) = do
|
||||
p_hsModule exts (L moduleSpan HsModule {..}) = do
|
||||
-- NOTE If span of exports in multiline, the whole thing is multiline.
|
||||
-- This is especially important because span of module itself always seems
|
||||
-- to have length zero, so it's not reliable for layout selection.
|
||||
let spn =
|
||||
case hsmodExports hsModule of
|
||||
Nothing -> moduleSpan
|
||||
Just (L exportsSpan _) -> combineSrcSpans moduleSpan exportsSpan
|
||||
locatedVia (Just spn) loc $ \HsModule {..} -> do
|
||||
let spans' = case hsmodExports of
|
||||
Nothing -> [moduleSpan]
|
||||
Just (L exportsSpan _) -> moduleSpan : [exportsSpan]
|
||||
switchLayout spans' $ do
|
||||
let hasLangPragmas = not (null exts)
|
||||
hasModuleHeader = isJust hsmodName
|
||||
hasImports = not (null hsmodImports)
|
||||
@ -49,7 +47,7 @@ p_hsModule exts loc@(L moduleSpan hsModule) = do
|
||||
Nothing -> return ()
|
||||
Just hsmodExports' -> do
|
||||
breakpoint
|
||||
inci (locatedVia Nothing hsmodExports' p_hsmodExports)
|
||||
inci (p_hsmodExports (unLoc hsmodExports'))
|
||||
breakpoint
|
||||
txt "where"
|
||||
when (hasImports || hasDecls) newline
|
||||
|
@ -22,16 +22,16 @@ p_hsType :: HsType GhcPs -> R ()
|
||||
p_hsType = \case
|
||||
HsForAllTy NoExt bndrs t -> do
|
||||
txt "forall "
|
||||
spaceSep (located' p_hsTyVarBndr) bndrs
|
||||
sep space (located' p_hsTyVarBndr) bndrs
|
||||
txt ". "
|
||||
locatedVia Nothing t p_hsType
|
||||
p_hsType (unLoc t)
|
||||
HsQualTy NoExt qs t -> do
|
||||
located qs p_hsContext
|
||||
breakpoint
|
||||
txt "=> "
|
||||
case unLoc t of
|
||||
HsQualTy {} -> locatedVia Nothing t p_hsType
|
||||
HsFunTy {} -> locatedVia Nothing t p_hsType
|
||||
HsQualTy {} -> p_hsType (unLoc t)
|
||||
HsFunTy {} -> p_hsType (unLoc t)
|
||||
_ -> located t p_hsType
|
||||
HsTyVar NoExt p n -> do
|
||||
case p of
|
||||
@ -60,9 +60,11 @@ p_hsType = \case
|
||||
HsBoxedTuple -> parens
|
||||
HsConstraintTuple -> parens
|
||||
HsBoxedOrConstraintTuple -> parens
|
||||
in parens' . velt $ withSep comma (located' p_hsType) xs
|
||||
in parens' . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
|
||||
HsSumTy NoExt xs ->
|
||||
parensHash . velt $ withSep (txt "| ") (located' p_hsType) xs
|
||||
parensHash . sitcc $
|
||||
sep (txt "| " >> breakpoint') (sitcc . located' p_hsType) xs
|
||||
HsOpTy NoExt x op y -> do
|
||||
located x p_hsType
|
||||
breakpoint
|
||||
@ -115,10 +117,10 @@ p_hsType = \case
|
||||
case xs of
|
||||
((L _ (HsTyVar _ Promoted _)):_) -> space
|
||||
_ -> return ()
|
||||
velt $ withSep comma (located' p_hsType) xs
|
||||
sitcc $ sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
|
||||
HsExplicitTupleTy NoExt xs -> do
|
||||
txt "'"
|
||||
parens . velt $ withSep comma (located' p_hsType) xs
|
||||
parens $ sep (comma >> breakpoint) (located' p_hsType) xs
|
||||
HsTyLit NoExt t -> atom t
|
||||
HsWildCardTy NoExt -> txt "_"
|
||||
XHsType (NHsCoreTy t) -> atom t
|
||||
@ -127,7 +129,8 @@ p_hsContext :: HsContext GhcPs -> R ()
|
||||
p_hsContext = \case
|
||||
[] -> txt "()"
|
||||
[x] -> located x p_hsType
|
||||
xs -> parens . velt $ withSep comma (located' p_hsType) xs
|
||||
xs -> parens . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_hsType) xs
|
||||
|
||||
p_hsTyVarBndr :: HsTyVarBndr GhcPs -> R ()
|
||||
p_hsTyVarBndr = \case
|
||||
@ -142,23 +145,22 @@ p_hsTyVarBndr = \case
|
||||
XTyVarBndr NoExt -> notImplemented "XTyVarBndr"
|
||||
|
||||
p_conDeclFields :: [LConDeclField GhcPs] -> R ()
|
||||
p_conDeclFields =
|
||||
braces . velt . withSep comma (sitcc . located' p_conDeclField)
|
||||
p_conDeclFields xs = braces . sitcc $
|
||||
sep (comma >> breakpoint) (sitcc . located' p_conDeclField) xs
|
||||
|
||||
p_conDeclField :: ConDeclField GhcPs -> R ()
|
||||
p_conDeclField ConDeclField {..} = do
|
||||
sitcc . velt $ withSep
|
||||
comma
|
||||
sitcc $ sep (comma >> breakpoint)
|
||||
(located' (p_rdrName . rdrNameFieldOcc))
|
||||
cd_fld_names
|
||||
breakpoint
|
||||
sitcc . inci $ do
|
||||
txt ":: "
|
||||
locatedVia Nothing cd_fld_type p_hsType
|
||||
p_hsType (unLoc cd_fld_type)
|
||||
p_conDeclField (XConDeclField NoExt) = notImplemented "XConDeclField"
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- Convertion functions
|
||||
-- Conversion functions
|
||||
|
||||
tyVarsToTypes :: LHsQTyVars GhcPs -> [LHsType GhcPs]
|
||||
tyVarsToTypes = \case
|
||||
|
@ -1,5 +1,7 @@
|
||||
-- | Random utilities used by the code.
|
||||
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
|
||||
module Ormolu.Utils
|
||||
( combineSrcSpans'
|
||||
, isModule
|
||||
|
@ -47,27 +47,27 @@ rSimpleSig :: R ()
|
||||
rSimpleSig = line rFn
|
||||
|
||||
rList0 :: R ()
|
||||
rList0 = line . brackets $
|
||||
velt
|
||||
rList0 = line . brackets . sitcc $
|
||||
sep (comma >> breakpoint) id
|
||||
[ txt "foo"
|
||||
, comma >> txt "bar"
|
||||
, comma >> txt "baz"
|
||||
, txt "bar"
|
||||
, txt "baz"
|
||||
]
|
||||
|
||||
rList1 :: R ()
|
||||
rList1 = line . brackets $
|
||||
velt
|
||||
rList1 = line . brackets . sitcc $
|
||||
sep (comma >> breakpoint) id
|
||||
[ txt "foo"
|
||||
, comma >> txt "bar"
|
||||
, comma >> rFn
|
||||
, txt "bar"
|
||||
, rFn
|
||||
]
|
||||
|
||||
rFn :: R ()
|
||||
rFn = velt'
|
||||
rFn = sitcc $ sep breakpoint sitcc
|
||||
[ txt "foo"
|
||||
, inci $ velt'
|
||||
, inci . sitcc $ sep breakpoint sitcc
|
||||
[ do txt ":: "
|
||||
parens $ velt'
|
||||
parens . sitcc $ sep breakpoint sitcc
|
||||
[ txt "Int"
|
||||
, txt "-> " >> txt "Int"
|
||||
]
|
||||
@ -80,11 +80,11 @@ rModuleHeader = do
|
||||
line $ do
|
||||
txt "module "
|
||||
txt "MyModule"
|
||||
line . inci . parens . velt $
|
||||
line . inci . parens . sitcc . sep (comma >> breakpoint) sitcc $
|
||||
[ txt "R"
|
||||
, comma >> txt "runR"
|
||||
, comma >> txt "txt"
|
||||
, comma >> txt "blah"
|
||||
, txt "runR"
|
||||
, txt "txt"
|
||||
, txt "blah"
|
||||
]
|
||||
line (txt "where")
|
||||
|
||||
@ -96,8 +96,10 @@ rModuleHeader = do
|
||||
|
||||
shouldRender :: R () -> FilePath -> Expectation
|
||||
shouldRender m path = do
|
||||
let rendered = runR False m mempty mempty emptyAnns
|
||||
-- T.writeFile path rendered
|
||||
expected <- T.readFile path
|
||||
runR False m mempty mempty emptyAnns `shouldBe` expected
|
||||
rendered `shouldBe` expected
|
||||
|
||||
-- | Render using single-line layout.
|
||||
|
||||
|
@ -32,6 +32,7 @@ checkExample srcPath' = it (fromRelFile srcPath' ++ " works") $ do
|
||||
formatted0 <- ormoluFile defaultConfig (fromRelFile srcPath)
|
||||
-- 3. Check the output against expected output. Thus all tests should
|
||||
-- include two files: input and expected output.
|
||||
-- T.writeFile (fromRelFile expectedOutputPath) formatted0
|
||||
expected <- (liftIO . T.readFile . fromRelFile) expectedOutputPath
|
||||
shouldMatch False formatted0 expected
|
||||
-- 4. Check that running the formatter on the output produces the same
|
||||
|
Loading…
Reference in New Issue
Block a user