Deny one layout for OpApp cases unless precedence<=1

Previously allowed: `foo = abc + def-as-par`
Still allowed:      `foo = abc $ def-as-par`
Still allowed:      `foo = abc <&> \x -> def-as-par`
ghc92
Lennart Spitzner 2023-05-08 10:51:27 +00:00
parent e7cdff440d
commit 7bf2879ac0
3 changed files with 60 additions and 46 deletions

View File

@ -329,7 +329,9 @@ func =
foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-3 #test opapp-specialcasing-3
func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo func =
fooooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
[ foooooooooooooooooooooooooooooooo [ foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo , foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo , foooooooooooooooooooooooooooooooo
@ -966,3 +968,8 @@ func =
) )
<$> mylist <$> mylist
) )
#test operator newline behaviour
func =
fromIntegral aaaaaaaaaaaaaaaaaaa
/ fromIntegral (aaaaaaaaaaaaaaaaaaa + bbbbbbbbbbbbbbbbbb)

View File

@ -1278,7 +1278,9 @@ func =
foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
#test opapp-specialcasing-3 #test opapp-specialcasing-3
func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo func =
fooooooooooooooooooooooooooooooooo
+ foooooooooooooooooooooooooooooooo
[ foooooooooooooooooooooooooooooooo [ foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo , foooooooooooooooooooooooooooooooo
, foooooooooooooooooooooooooooooooo , foooooooooooooooooooooooooooooooo

View File

@ -198,6 +198,9 @@ layoutOpTree allowSinglelinePar = \case
pure (pure op, subDoc) pure (pure op, subDoc)
sharedOpsFlat <- flattenList docOps sharedOpsFlat <- flattenList docOps
sharedOps <- simpleTransform docOps sharedOps <- simpleTransform docOps
let lastWrap = if getPrec fixity <= 1
then docForceParSpacing
else docForceSingleline
coreAlternative hasParen coreAlternative hasParen
locO locO
locC locC
@ -205,11 +208,12 @@ layoutOpTree allowSinglelinePar = \case
docL docL
sharedOps sharedOps
sharedOpsFlat sharedOpsFlat
docForceParSpacing lastWrap
OpLeaf l -> pure l OpLeaf l -> pure l
where where
isPrec0 = \case isPrec0 x = getPrec x == 0
Fixity _ prec _ -> prec == 0 getPrec = \case
Fixity _ prec _ -> prec
coreAlternative coreAlternative
:: Bool :: Bool
-> Maybe GHC.RealSrcLoc -> Maybe GHC.RealSrcLoc
@ -271,7 +275,11 @@ layoutOpTree allowSinglelinePar = \case
([docForceSingleline docL] ++ case splitFirstLast sharedOpsFlat of ([docForceSingleline docL] ++ case splitFirstLast sharedOpsFlat of
FirstLastEmpty -> [] FirstLastEmpty -> []
FirstLastSingleton (od, ed) -> FirstLastSingleton (od, ed) ->
[docSeparator, docForceSingleline od, docSeparator, lastWrap ed] [ docSeparator
, docForceSingleline od
, docSeparator
, lastWrap ed
]
FirstLast (od1, ed1) ems (odN, edN) -> FirstLast (od1, ed1) ems (odN, edN) ->
( [ docSeparator ( [ docSeparator
, docForceSingleline od1 , docForceSingleline od1
@ -293,8 +301,6 @@ layoutOpTree allowSinglelinePar = \case
] ]
) )
) )
-- this case rather leads to some unfortunate layouting than to anything
-- useful; disabling for now. (it interfers with cols stuff.)
-- one -- one
-- + two -- + two
-- + three -- + three
@ -314,8 +320,7 @@ layoutOpTree allowSinglelinePar = \case
[(od, ed)] | curIsPrec0 -> [(od, ed)] | curIsPrec0 ->
addAlternativeCond (not hasParen && isSingleOp) addAlternativeCond (not hasParen && isSingleOp)
$ docSetParSpacing $ docSetParSpacing
$ docPar $ docPar (docHandleComms locO $ docForceSingleline $ docL)
(docHandleComms locO $ docForceSingleline $ docL)
(docSeq [od, docSeparator, singlelineUnlessFree ed]) (docSeq [od, docSeparator, singlelineUnlessFree ed])
_ -> pure () _ -> pure ()
-- > ( one -- > ( one