From e24271318d4bdbd16c2bb9cbdacc63c66575395c Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Thu, 5 Dec 2019 14:30:50 +0100 Subject: [PATCH] Improve record-expression layouting - Finish consolidation, clearing a TODO - Fix two comment placement issues around record wildcards - Fix regression in brittany-0.12 about layouting large (multiline) record field updates --- src-literatetests/15-regressions.blt | 84 ++++++++++- .../Brittany/Internal/Layouters/Expr.hs | 138 +++++++----------- 2 files changed, 138 insertions(+), 84 deletions(-) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index 8942d3f..07cc3a9 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -366,8 +366,23 @@ runBrittany tabSize text = do let config' = staticDefaultConfig config = config' - { _conf_layout = - (_conf_layout config') { _lconfig_indentAmount = coerce tabSize } + { _conf_layout = (_conf_layout config') { _lconfig_indentAmount = coerce + tabSize + } + , _conf_forward = forwardOptionsSyntaxExtsEnabled + } + parsePrintModule config text + +#test recordupd-singleline-bug-left + +-- brittany { lconfig_indentPolicy: IndentPolicyLeft } +runBrittany tabSize text = do + let + config' = staticDefaultConfig + config = config' + { _conf_layout = (_conf_layout config') + { _lconfig_indentAmount = coerce tabSize + } , _conf_forward = forwardOptionsSyntaxExtsEnabled } parsePrintModule config text @@ -690,3 +705,68 @@ func :: forall b . Show b => b -> String {-# LANGUAGE TypeFamilies #-} f :: ((~) a b) => a -> b f = id + +#test large record update +-- brittany { lconfig_indentPolicy: IndentPolicyLeft } +vakjkeSulxudbFokvir = Duotpo + { _ekku_gcrpbze = xgonae (1 :: Int) + , _oola_louwu = FoqsiYcuidx + { _xxagu_umea_iaztoj = xgonae False + , _tuktg_tizo_kfikacygsqf = xgonae False + , _ahzbo_xpow_otq_nzeyufq = xgonae False + , _uagpi_lzps_luy_xcjn = xgonae False + , _dxono_qjef_aqtafq_bes = xgonae False + , _yzuaf_nviy_vuhwxe_ihnbo_uhw = xgonae False + , _iwcit_fzjs_yerakt_dicox_mtryitko = xgonae False + , _ehjim_ucfe_dewarp_newrt_gso = xgonae False + , _ogtxb_ivoj_amqgai_rttui_xuwhetb = xgonae False + , _bhycb_iexz_megaug_qunoa_ohaked = xgonae False + , _nnmbe_uqgt_ewsuga_vaiis = xgonae False + , _otzil_ucvugaiyj_aosoiatunx_asir = xgonae False + } + , _iwsc_lalojz = XqspaiDainqw + { _uajznac_ugah = xgonae (80 :: Int) + , _qayziku_gazibzDejipj = xgonae DewizeCxwgyiKjig + , _auhebll_fiqjxyArfxia = xgonae (2 :: Int) + , _zubfuhq_dupiwnIoophXameeet = xgonae True + , _oavnuqg_opkreyOufuIkifiin = xgonae True + , _ufojfwy_fhuzcePeqwfu = xgonae (50 :: Int) + , _mlosikq_zajdxxSeRoelpf = xgonae (50 :: Int) + , _heemavf_fjgOfoaikh = xgonae (FyoVfvdygaZuzuvbeWarwuq 3) + , _ohxmeoq_ogtbfoPtqezVseu = xgonae (EdjotoLcbapUdiuMmytwoig 0.7) + , _omupuiu_ituamexjuLccwu = xgonae (30 :: Int) + , _xoseksf_atvwwdwaoHanofMyUvujjopoz = xgonae True + , _umuuuat_nuamezwWeqfUqzrnaxwp = xgonae False + , _uuriguz_wixhutbuKecigaFiwosret = xgonae True + , _betohxp_scixaLsvcesErtwItxrnaJmuz = xgonae False + , _lchxgee_olaetGcqzuqxVujenCzexub = xgonae True + , _egeibao_imamkuigqikhZdcbpidokVcixiqew = xgonae False + } + , _nloo_cfmrgZcisiugk = YuwodSavxwnicBekuel + { _oebew_rrtpvthUzlizjAqIwesly = xgonae False + , _blkff_Acxoid = xgonae False + , _datei_YewolAowoqOpunvpgu = xgonae BeekgUzojaPnixxaruJehyPmnnfu + , _ejfrj_eheb_justvh_pumcp_ismya = xgonae False + } + , _kena_uzeddovosoki = NyoRvshullezUpauud + { _mtfuwi_TUVEmoi = xgonae RZXKoytUtogx + , _larqam_adaxPehaylZafeqgpc = xgonae False + } + , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] } + , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False + , _qaqb_eykzuyuwi = xgonae False + -- test comment + } + +#test large record wildcard comment + +-- brittany { lconfig_indentPolicy: IndentPolicyLeft } +vakjkeSulxudbFokvir = Duotpo + { _ekku_gcrpbze = xgonae (1 :: Int) + , _spob_qipaarx = KaxavsmOtoyeaq { _rusrirw_okx = Tajemkix [] } + , _vmah_uivucnfka_ikaquebxay_gzcm = xgonae False + , _qaqb_eykzuyuwi = xgonae False + -- test comment + , -- N.B. + .. -- x + } diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 60be59f..df5ee2a 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -974,12 +974,11 @@ layoutExpr lexpr@(L _ expr) = do then return Nothing else Just <$> docSharedWrapper layoutExpr rFExpr return $ (lfield, lrdrNameToText lnameF, rFExpDoc) - recordExpression indentPolicy lexpr nameDoc rFs + recordExpression False indentPolicy lexpr nameDoc rFs HsRecFields [] (Just 0) -> do let t = lrdrNameToText lname docWrapNode lname $ docLit $ t <> Text.pack " { .. }" HsRecFields fs@(_:_) (Just dotdoti) | dotdoti == length fs -> do - -- TODO this should be consolidated into `recordExpression` let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname fieldDocs <- fs `forM` \fieldl@(L _ (HsRecField (L _ fieldOcc) fExpr pun)) -> do #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ @@ -991,54 +990,7 @@ layoutExpr lexpr@(L _ expr) = do then return Nothing else Just <$> docSharedWrapper layoutExpr fExpr return (fieldl, lrdrNameToText lnameF, fExpDoc) - let ((fd1l, fd1n, fd1e):fdr) = fieldDocs - let line1 wrapper = - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior fd1l $ appSep $ docLit fd1n - , case fd1e of - Just x -> docSeq - [ appSep $ docLit $ Text.pack "=" - , docWrapNodeRest fd1l $ wrapper x - ] - Nothing -> docEmpty - ] - let lineR wrapper = fdr <&> \(lfield, fText, fDoc) -> - [ docCommaSep - , appSep $ docLit fText - , case fDoc of - Just x -> docWrapNode lfield $ docSeq - [ appSep $ docLit $ Text.pack "=" - , wrapper x - ] - Nothing -> docEmpty - ] - let lineDot = - [ docCommaSep - , docLit $ Text.pack ".." - ] - let lineN = - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - docAlt -- TODO: make this addFilteredAlternative and a hanging layout when Free - [ docSeq - $ [docNodeAnnKW lexpr Nothing nameDoc, docSeparator] - ++ line1 docForceSingleline - ++ join (lineR docForceSingleline) - ++ lineDot - ++ [docSeparator] - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRec $ line1 (docAddBaseY BrIndentRegular)] - ++ (docCols ColRec <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineDot, docSeq lineN] - ) - ] + recordExpression True indentPolicy lexpr nameDoc fieldDocs _ -> unknownNodeError "RecordCon with puns" lexpr #if MIN_VERSION_ghc(8,6,0) /* ghc-8.6 */ RecordUpd _ rExpr fields -> do @@ -1061,7 +1013,7 @@ layoutExpr lexpr@(L _ expr) = do Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) #endif - recordExpression indentPolicy lexpr rExprDoc rFs + recordExpression False indentPolicy lexpr rExprDoc rFs #if MIN_VERSION_ghc(8,8,0) /* ghc-8.6 */ ExprWithTySig _ _ (HsWC _ XHsImplicitBndrs{}) -> error "brittany internal error: ExprWithTySig HsWC XHsImplicitBndrs" @@ -1225,24 +1177,32 @@ layoutExpr lexpr@(L _ expr) = do recordExpression :: (Data.Data.Data lExpr, Data.Data.Data name) - => IndentPolicy + => Bool + -> IndentPolicy -> GenLocated SrcSpan lExpr -> ToBriDocM BriDocNumbered -> [(GenLocated SrcSpan name, Text, Maybe (ToBriDocM BriDocNumbered))] -> ToBriDocM BriDocNumbered -recordExpression _ lexpr nameDoc [] = +recordExpression False _ lexpr nameDoc [] = docSeq [ docNodeAnnKW lexpr (Just AnnOpenC) $ docSeq [nameDoc, docLit $ Text.pack "{"] , docLit $ Text.pack "}" ] -recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) = +recordExpression True _ lexpr nameDoc [] = + docSeq -- this case might still be incomplete, and is probably not used + -- atm anyway. + [ docNodeAnnKW lexpr (Just AnnOpenC) $ docSeq [nameDoc, docLit $ Text.pack "{"] + , docLit $ Text.pack " .. }" + ] +recordExpression dotdot indentPolicy lexpr nameDoc rFs@(rF1:rFr) = do + let (rF1f, rF1n, rF1e) = rF1 runFilteredAlternative $ do -- container { fieldA = blub, fieldB = blub } addAlternative $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline nameDoc , appSep $ docLit $ Text.pack "{" - , appSep $ docSeq $ List.intersperse docCommaSep + , docSeq $ List.intersperse docCommaSep $ rFs <&> \case (lfield, fieldStr, Just fieldDoc) -> docWrapNode lfield $ docSeq @@ -1252,6 +1212,9 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) = ] (lfield, fieldStr, Nothing) -> docWrapNode lfield $ docLit fieldStr + , if dotdot + then docSeq [ docCommaSep, docLit $ Text.pack "..", docSeparator] + else docSeparator , docLit $ Text.pack "}" ] -- hanging single-line fields @@ -1281,11 +1244,15 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) = ] Nothing -> docEmpty ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] + dotdotLine = if dotdot + then docCols ColRec + [ docNodeAnnKW lexpr (Just AnnOpenC) docCommaSep + , docNodeAnnKW lexpr (Just AnnDotdot) + $ docLit $ Text.pack ".." + ] + else docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + lineN = docLit $ Text.pack "}" + in [line1] ++ lineR ++ [dotdotLine, lineN] ] -- non-hanging with expressions placed to the right of the names -- container @@ -1299,21 +1266,20 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) = $ docPar (docNodeAnnKW lexpr Nothing nameDoc) (docNonBottomSpacing $ docLines $ let - expressionWrapper = case indentPolicy of - IndentPolicyLeft -> docForceParSpacing - IndentPolicyMultiple -> docForceParSpacing - IndentPolicyFree -> docSetBaseY line1 = docCols ColRec [ appSep $ docLit $ Text.pack "{" , docWrapNodePrior rF1f $ appSep $ docLit rF1n , docWrapNodeRest rF1f $ case rF1e of - Just x -> docAlt - [ docSeq [ appSep $ docLit $ Text.pack "=" - , expressionWrapper x - ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "=") x - ] + Just x -> runFilteredAlternative $ do + addAlternativeCond (indentPolicy == IndentPolicyFree) $ do + docSeq + [appSep $ docLit $ Text.pack "=", docSetBaseY x] + addAlternative $ do + docSeq + [appSep $ docLit $ Text.pack "=", docForceParSpacing x] + addAlternative $ do + docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "=") x Nothing -> docEmpty ] lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield @@ -1321,20 +1287,28 @@ recordExpression indentPolicy lexpr nameDoc rFs@((rF1f, rF1n, rF1e):rFr) = [ docCommaSep , appSep $ docLit fText , case fDoc of - Just x -> docAlt - [ docSeq [ appSep $ docLit $ Text.pack "=" - , expressionWrapper x + Just x -> runFilteredAlternative $ do + addAlternativeCond (indentPolicy == IndentPolicyFree) $ do + docSeq + [appSep $ docLit $ Text.pack "=", docSetBaseY x] + addAlternative $ do + docSeq [ appSep $ docLit $ Text.pack "=" + , docForceParSpacing x ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "=") x - ] + addAlternative $ do + docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "=") x Nothing -> docEmpty ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] + dotdotLine = if dotdot + then docCols ColRec + [ docNodeAnnKW lexpr (Just AnnOpenC) docCommaSep + , docNodeAnnKW lexpr (Just AnnDotdot) + $ docLit $ Text.pack ".." + ] + else docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + lineN = docLit $ Text.pack "}" + in [line1] ++ lineR ++ [dotdotLine, lineN] ) #if MIN_VERSION_ghc(8,4,0) /* ghc-8.4 */