hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Fix two minor data-decl layouting issues

pull/259/head
Lennart Spitzner 2019-12-09 22:35:26 +01:00
parent a1282c3ac6
commit 00c6854887
7 changed files with 138 additions and 85 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
src-literatetests/10-tests.blt
View File

@ -583,6 +583,30 @@ data EnterpriseGrantsForCompanyResponse = EnterpriseGrantsForCompanyResponse
data GrantsForCompanyResp = GrantsForCompanyResp Types.Company
[EnterpriseGrantResponse]
#test large record with a comment
data XIILqcacwiuNiu = XIILqcacwiuNiu
{ oyyFtvbepgbOge_pebzVmuftEijwuj :: Jgtoyuh HessJvNlo
, wloQsiskdoxJop_xatiKrwedOxtu :: Jgtoyuh [Inotg]
, mmmJjcqtemyIyo_ovosDoreKeeoyamvove :: Jgtoyuh Eujo
, mbiIatelofxOzr_uluxNngiiMjah :: Jgtoyuh HessJvNlo
, obxIskfcxpkIkb_uuviTuevcSkrgo :: Jgtoyuh Int
, wqrAtuvuecoHwr_ilotNxbuPleo :: Jgtoyuh Ufaxdeq
, lofAfuebdhpLuv_cnekPoyFxmg :: Jgtoyuh Ufaxdeq
, ouoFugtawzvUpk_oupiLzptugy :: Jgtoyuh Eujo
, iqiXjtziwogNsa_uiyvSunaTtgUsf3 :: Jgtoyuh Oaivn
, odbIriaqnojUlz_onotoWuunehIpuy :: Jgtoyuh Eujo
, opjUxtkxzkiKse_luqjuZazt
:: Jgtoyuh [(Eujo, Int, Int, Int, Int, Int, NELUxro)]
-- , jcqRaqznxfhIpa_ywevMezmoYkutuwa :: Jgtoyuh ()
, vayOmuasyphOfd_bcsVljmvt :: Jgtoyuh Eujo
, rifArahilooRax_ufikecqdImsv :: Jgtoyuh Oaivn
, raqKtopcpszDwb_oqocubasZuqjcryoDojGkw :: Jgtoyuh Oaivn
, mluJiilpcijUtt_gaisklifVekfeyagRmfbyzz :: Jgtoyuh Oaivn
, oqhPaahjupaSmi_gamwwoovKyxznecvEayluc :: Jgtoyuh Oaivn
, mazFubimwebZpa_itidehDodiDlboz :: Jgtoyuh Vrep
, jeyOcuesexaYoy_vpqn :: Jgtoyuh ()
}
###############################################################################
###############################################################################
###############################################################################

8
src/Language/Haskell/Brittany/Internal/Backend.hs
View File

@ -287,7 +287,7 @@ layoutBriDocM = \case
Just (ExactPrint.Types.DP (y, x)) ->
layoutMoveToCommentPos y (if shouldRestoreIndent then x else 0)
layoutBriDocM bd
BDNonBottomSpacing bd -> layoutBriDocM bd
BDNonBottomSpacing _ bd -> layoutBriDocM bd
BDSetParSpacing bd -> layoutBriDocM bd
BDForceParSpacing bd -> layoutBriDocM bd
BDDebug s bd -> do
@ -321,14 +321,14 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
BDAnnotationKW _ _ bd -> rec bd
BDAnnotationRest _ bd -> rec bd
BDMoveToKWDP _ _ _ bd -> rec bd
BDLines ls@(_:_) -> do
BDLines ls@(_ : _) -> do
x <- StateS.get
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
BDLines [] -> error "briDocLineLength BDLines []"
BDEnsureIndent _ bd -> rec bd
BDSetParSpacing bd -> rec bd
BDForceParSpacing bd -> rec bd
BDNonBottomSpacing bd -> rec bd
BDNonBottomSpacing _ bd -> rec bd
BDDebug _ bd -> rec bd
briDocIsMultiLine :: BriDoc -> Bool
@ -365,7 +365,7 @@ briDocIsMultiLine briDoc = rec briDoc
BDEnsureIndent _ bd -> rec bd
BDSetParSpacing bd -> rec bd
BDForceParSpacing bd -> rec bd
BDNonBottomSpacing bd -> rec bd
BDNonBottomSpacing _ bd -> rec bd
BDDebug _ bd -> rec bd
-- In theory

6
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -40,6 +40,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docAnnotationRest
, docMoveToKWDP
, docNonBottomSpacing
, docNonBottomSpacingS
, docSetParSpacing
, docForceParSpacing
, docDebug
@ -576,7 +577,10 @@ docAnnotationRest
docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm
docNonBottomSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing =<< bdm
docNonBottomSpacing bdm = allocateNode . BDFNonBottomSpacing False =<< bdm
docNonBottomSpacingS :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docNonBottomSpacingS bdm = allocateNode . BDFNonBottomSpacing True =<< bdm
docSetParSpacing :: ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docSetParSpacing bdm = allocateNode . BDFSetParSpacing =<< bdm

11
src/Language/Haskell/Brittany/Internal/Layouters/DataDecl.hs
View File

@ -153,7 +153,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
]
, docLitS "="
, docSeparator
, case forallDocMay of
, docSetIndentLevel $ docSeq
[ case forallDocMay of
Nothing -> docEmpty
Just forallDoc -> docSeq
[ docForceSingleline forallDoc
@ -164,6 +165,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
, maybe docEmpty docForceSingleline rhsContextDocMay
, rhsDoc
]
]
, -- data D
-- = forall a . Show a => D a
docAddBaseY BrIndentRegular $ docPar
@ -178,7 +180,8 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
( docSeq
[ docLitS "="
, docSeparator
, case forallDocMay of
, docSetIndentLevel $ docSeq
[ case forallDocMay of
Nothing -> docEmpty
Just forallDoc -> docSeq
[ docForceSingleline forallDoc
@ -189,6 +192,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs _) defn = case defn of
, maybe docEmpty docForceSingleline rhsContextDocMay
, rhsDoc
]
]
)
, -- data D
-- = forall a
@ -412,7 +416,6 @@ createDetailsDoc consNameStr details = case details of
-- allowSingleline <- mAsk <&> _conf_layout .> _lconfig_allowSinglelineRecord .> confUnpack
let allowSingleline = False
docAddBaseY BrIndentRegular
$ docSetIndentLevel
$ runFilteredAlternative
$ do
-- single-line: { i :: Int, b :: Bool }
@ -441,7 +444,7 @@ createDetailsDoc consNameStr details = case details of
]
addAlternative $ docPar
(docLit consNameStr)
(docWrapNodePrior lRec $ docLines
(docWrapNodePrior lRec $ docNonBottomSpacingS $ docLines
[ docAlt
[ docCols ColRecDecl
[ appSep (docLitS "{")

37
src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
View File

@ -331,7 +331,7 @@ transformAlts =
BrIndentNone -> r
BrIndentRegular -> reWrap $ BDFEnsureIndent (BrIndentSpecial indAdd) r
BrIndentSpecial i -> reWrap $ BDFEnsureIndent (BrIndentSpecial i) r
BDFNonBottomSpacing bd -> rec bd
BDFNonBottomSpacing _ bd -> rec bd
BDFSetParSpacing bd -> rec bd
BDFForceParSpacing bd -> rec bd
BDFDebug s bd -> do
@ -488,13 +488,18 @@ getSpacing !bridoc = rec bridoc
BrIndentSpecial i -> i
return $ mVs <&> \(VerticalSpacing lsp psp pf) ->
VerticalSpacing (lsp + addInd) psp pf
BDFNonBottomSpacing bd -> do
BDFNonBottomSpacing b bd -> do
mVs <- rec bd
return
$ mVs
<|> LineModeValid (VerticalSpacing 0
(VerticalSpacingParAlways colMax)
False)
<|> LineModeValid
(VerticalSpacing
0
(if b then VerticalSpacingParSome 0
else VerticalSpacingParAlways colMax
)
False
)
BDFSetParSpacing bd -> do
mVs <- rec bd
return $ mVs <&> \vs -> vs { _vs_parFlag = True }
@ -799,16 +804,30 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BrIndentSpecial i -> i
return $ mVs <&> \(VerticalSpacing lsp psp parFlag) ->
VerticalSpacing (lsp + addInd) psp parFlag
BDFNonBottomSpacing bd -> do
BDFNonBottomSpacing b bd -> do
-- TODO: the `b` flag is an ugly hack, but I was not able to make
-- all tests work without it. It should be possible to have
-- `spMakePar` map VSPAlways{} to VSPSome x1, which fixes this
-- problem but breaks certain other cases.
mVs <- rec bd
return $ if null mVs
then [VerticalSpacing 0 (VerticalSpacingParAlways colMax) False]
then [VerticalSpacing
0
(if b then VerticalSpacingParSome 0
else VerticalSpacingParAlways colMax
)
False
]
else mVs <&> \vs -> vs
{ _vs_sameLine = min colMax (_vs_sameLine vs)
, _vs_paragraph = case _vs_paragraph vs of
VerticalSpacingParNone -> VerticalSpacingParNone
VerticalSpacingParAlways i -> VerticalSpacingParAlways i
VerticalSpacingParSome i -> VerticalSpacingParAlways i
VerticalSpacingParAlways i
| b -> VerticalSpacingParSome 0
| otherwise -> VerticalSpacingParAlways i
VerticalSpacingParSome i
| b -> VerticalSpacingParSome 0
| otherwise -> VerticalSpacingParAlways i
}
-- the version below is an alternative idea: fold the input
-- spacings into a single spacing. This was hoped to improve in

2
src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
View File

@ -135,4 +135,4 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
BDSetParSpacing{} -> Nothing
BDForceParSpacing{} -> Nothing
BDDebug{} -> Nothing
BDNonBottomSpacing x -> Just x
BDNonBottomSpacing _ x -> Just x

45
src/Language/Haskell/Brittany/Internal/Types.hs
View File

@ -258,7 +258,7 @@ data BriDoc
-- after the alt transformation.
| BDForceMultiline BriDoc
| BDForceSingleline BriDoc
| BDNonBottomSpacing BriDoc
| BDNonBottomSpacing Bool BriDoc
| BDSetParSpacing BriDoc
| BDForceParSpacing BriDoc
-- pseudo-deprecated
@ -303,7 +303,7 @@ data BriDocF f
| BDFEnsureIndent BrIndent (f (BriDocF f))
| BDFForceMultiline (f (BriDocF f))
| BDFForceSingleline (f (BriDocF f))
| BDFNonBottomSpacing (f (BriDocF f))
| BDFNonBottomSpacing Bool (f (BriDocF f))
| BDFSetParSpacing (f (BriDocF f))
| BDFForceParSpacing (f (BriDocF f))
| BDFDebug String (f (BriDocF f))
@ -317,31 +317,35 @@ type BriDocNumbered = (Int, BriDocFInt)
instance Uniplate.Uniplate BriDoc where
uniplate x@BDEmpty{} = plate x
uniplate x@BDLit{} = plate x
uniplate (BDSeq list) = plate BDSeq ||* list
uniplate (BDSeq list ) = plate BDSeq ||* list
uniplate (BDCols sig list) = plate BDCols |- sig ||* list
uniplate x@BDSeparator = plate x
uniplate (BDAddBaseY ind bd) = plate BDAddBaseY |- ind |* bd
uniplate (BDAddBaseY ind bd ) = plate BDAddBaseY |- ind |* bd
uniplate (BDBaseYPushCur bd) = plate BDBaseYPushCur |* bd
uniplate (BDBaseYPop bd) = plate BDBaseYPop |* bd
uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd
uniplate (BDIndentLevelPop bd) = plate BDIndentLevelPop |* bd
uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented
uniplate (BDAlt alts) = plate BDAlt ||* alts
uniplate (BDAlt alts ) = plate BDAlt ||* alts
uniplate (BDForwardLineMode bd ) = plate BDForwardLineMode |* bd
uniplate x@BDExternal{} = plate x
uniplate x@BDPlain{} = plate x
uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
uniplate (BDAnnotationRest annKey bd) = plate BDAnnotationRest |- annKey |* bd
uniplate (BDMoveToKWDP annKey kw b bd) = plate BDMoveToKWDP |- annKey |- kw |- b |* bd
uniplate (BDLines lines) = plate BDLines ||* lines
uniplate (BDEnsureIndent ind bd) = plate BDEnsureIndent |- ind |* bd
uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd
uniplate (BDForceSingleline bd) = plate BDForceSingleline |* bd
uniplate (BDNonBottomSpacing bd) = plate BDNonBottomSpacing |* bd
uniplate (BDSetParSpacing bd) = plate BDSetParSpacing |* bd
uniplate (BDForceParSpacing bd) = plate BDForceParSpacing |* bd
uniplate (BDDebug s bd) = plate BDDebug |- s |* bd
uniplate (BDAnnotationPrior annKey bd) =
plate BDAnnotationPrior |- annKey |* bd
uniplate (BDAnnotationKW annKey kw bd) =
plate BDAnnotationKW |- annKey |- kw |* bd
uniplate (BDAnnotationRest annKey bd) =
plate BDAnnotationRest |- annKey |* bd
uniplate (BDMoveToKWDP annKey kw b bd) =
plate BDMoveToKWDP |- annKey |- kw |- b |* bd
uniplate (BDLines lines ) = plate BDLines ||* lines
uniplate (BDEnsureIndent ind bd ) = plate BDEnsureIndent |- ind |* bd
uniplate (BDForceMultiline bd ) = plate BDForceMultiline |* bd
uniplate (BDForceSingleline bd ) = plate BDForceSingleline |* bd
uniplate (BDNonBottomSpacing b bd) = plate BDNonBottomSpacing |- b |* bd
uniplate (BDSetParSpacing bd ) = plate BDSetParSpacing |* bd
uniplate (BDForceParSpacing bd ) = plate BDForceParSpacing |* bd
uniplate (BDDebug s bd ) = plate BDDebug |- s |* bd
newtype NodeAllocIndex = NodeAllocIndex Int
@ -371,12 +375,11 @@ unwrapBriDocNumbered tpl = case snd tpl of
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
BDFForceMultiline bd -> BDForceMultiline $ rec bd
BDFForceSingleline bd -> BDForceSingleline $ rec bd
BDFNonBottomSpacing bd -> BDNonBottomSpacing $ rec bd
BDFNonBottomSpacing b bd -> BDNonBottomSpacing b $ rec bd
BDFSetParSpacing bd -> BDSetParSpacing $ rec bd
BDFForceParSpacing bd -> BDForceParSpacing $ rec bd
BDFDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
where
rec = unwrapBriDocNumbered
where rec = unwrapBriDocNumbered
isNotEmpty :: BriDoc -> Bool
isNotEmpty BDEmpty = False
@ -408,7 +411,7 @@ briDocSeqSpine = \case
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd
BDForceSingleline bd -> briDocSeqSpine bd
BDNonBottomSpacing bd -> briDocSeqSpine bd
BDNonBottomSpacing _ bd -> briDocSeqSpine bd
BDSetParSpacing bd -> briDocSeqSpine bd
BDForceParSpacing bd -> briDocSeqSpine bd
BDDebug _s bd -> briDocSeqSpine bd