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