From 4568bd35533854a3950376bf3a13b96a941f25ad Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Thu, 21 Sep 2017 23:26:23 +0200 Subject: [PATCH 01/22] Prepare implementation for `IndentPolicyLeft` --- .../Haskell/Brittany/Internal/Config/Types.hs | 2 +- .../Brittany/Internal/Layouters/Expr.hs | 1850 +++++++++-------- .../Brittany/Internal/Layouters/Stmt.hs | 101 +- 3 files changed, 978 insertions(+), 975 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 4fd4765..d726d8a 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -191,7 +191,7 @@ data IndentPolicy = IndentPolicyLeft -- never create a new indentation at more | IndentPolicyFree -- can create new indentations whereever | IndentPolicyMultiple -- can create indentations only -- at any n * amount. - deriving (Show, Generic, Data) + deriving (Eq, Show, Generic, Data) data AltChooser = AltChooserSimpleQuick -- always choose last alternative. -- leads to tons of sparsely filled diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 90fd435..fe82e3c 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -13,6 +13,7 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString, AnnKeywordId(..) ) @@ -30,973 +31,974 @@ import Language.Haskell.Brittany.Internal.Layouters.Type layoutExpr :: ToBriDoc HsExpr -layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of - HsVar vname -> do - docLit =<< lrdrNameToTextAnn vname - HsUnboundVar var -> case var of - OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname - TrueExprHole oname -> docLit $ Text.pack $ occNameString oname - HsRecFld{} -> do - -- TODO - briDocByExactInlineOnly "HsRecFld" lexpr - HsOverLabel{} -> do - -- TODO - briDocByExactInlineOnly "HsOverLabel{}" lexpr - HsIPVar{} -> do - -- TODO - briDocByExactInlineOnly "HsOverLabel{}" lexpr - HsOverLit (OverLit olit _ _ _) -> do - allocateNode $ overLitValBriDoc olit - HsLit lit -> do - allocateNode $ litBriDoc lit - HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do - patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p - bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body - let funcPatternPartLine = - docCols ColCasePattern - $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) - docAlt - [ -- single line - docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ docForceSingleline funcPatternPartLine - , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceSingleline bodyDoc - ] - -- double line - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docSeq +layoutExpr lexpr@(L _ expr) = do + docWrapNode lexpr $ case expr of + HsVar vname -> do + docLit =<< lrdrNameToTextAnn vname + HsUnboundVar var -> case var of + OutOfScope oname _ -> docLit $ Text.pack $ occNameString oname + TrueExprHole oname -> docLit $ Text.pack $ occNameString oname + HsRecFld{} -> do + -- TODO + briDocByExactInlineOnly "HsRecFld" lexpr + HsOverLabel{} -> do + -- TODO + briDocByExactInlineOnly "HsOverLabel{}" lexpr + HsIPVar{} -> do + -- TODO + briDocByExactInlineOnly "HsOverLabel{}" lexpr + HsOverLit (OverLit olit _ _ _) -> do + allocateNode $ overLitValBriDoc olit + HsLit lit -> do + allocateNode $ litBriDoc lit + HsLam (MG (L _ [lmatch@(L _ (Match _ pats _ (GRHSs [lgrhs@(L _ (GRHS [] body))] (L _ EmptyLocalBinds))))]) _ _ _) -> do + patDocs <- pats `forM` \p -> fmap return $ colsWrapPat =<< layoutPat p + bodyDoc <- docAddBaseY BrIndentRegular <$> docSharedWrapper layoutExpr body + let funcPatternPartLine = + docCols ColCasePattern + $ (patDocs <&> (\p -> docSeq [docForceSingleline p, docSeparator])) + docAlt + [ -- single line + docSeq [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine - , docLit $ Text.pack "->" - ]) - (docWrapNode lgrhs $ docForceSingleline bodyDoc) - -- wrapped par spacing - , docSetParSpacing - $ docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ docForceSingleline funcPatternPartLine - , appSep $ docLit $ Text.pack "->" - , docWrapNode lgrhs $ docForceParSpacing bodyDoc - ] - -- conservative - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docSeq - [ docLit $ Text.pack "\\" - , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine - , docLit $ Text.pack "->" - ]) - (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc) - ] - HsLam{} -> - unknownNodeError "HsLam too complex" lexpr -#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do -#else /* ghc-8.0 */ - HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do -#endif - binderDoc <- docLit $ Text.pack "->" - funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches - docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "\\case") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - HsApp exp1@(L _ HsApp{}) exp2 -> do - let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName]) - gather list = \case - (L _ (HsApp l r)) -> gather (r:list) l - x -> (x, list) - let (headE, paramEs) = gather [exp2] exp1 - headDoc <- docSharedWrapper layoutExpr headE - paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs - docAlt - [ -- foo x y - docCols ColApp - $ appSep (docForceSingleline headDoc) - : spacifyDocs (docForceSingleline <$> paramDocs) - , -- foo x - -- y - docSeq - [ appSep (docForceSingleline headDoc) - , docSetBaseY + , docWrapNode lmatch $ docForceSingleline funcPatternPartLine + , appSep $ docLit $ Text.pack "->" + , docWrapNode lgrhs $ docForceSingleline bodyDoc + ] + -- double line + , docSetParSpacing $ docAddBaseY BrIndentRegular - $ docLines - $ (docForceSingleline <$> paramDocs) + $ docPar + (docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine + , docLit $ Text.pack "->" + ]) + (docWrapNode lgrhs $ docForceSingleline bodyDoc) + -- wrapped par spacing + , docSetParSpacing + $ docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ docForceSingleline funcPatternPartLine + , appSep $ docLit $ Text.pack "->" + , docWrapNode lgrhs $ docForceParSpacing bodyDoc + ] + -- conservative + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docSeq + [ docLit $ Text.pack "\\" + , docWrapNode lmatch $ appSep $ docForceSingleline funcPatternPartLine + , docLit $ Text.pack "->" + ]) + (docWrapNode lgrhs $ docNonBottomSpacing bodyDoc) ] - , -- foo - -- x - -- y - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docForceSingleline headDoc) - ( docNonBottomSpacing - $ docLines paramDocs - ) - , -- ( multi - -- line - -- function - -- ) - -- x - -- y - docAddBaseY BrIndentRegular - $ docPar - headDoc - ( docNonBottomSpacing - $ docLines paramDocs - ) - ] - HsApp exp1 exp2 -> do - -- TODO: if expDoc1 is some literal, we may want to create a docCols here. - expDoc1 <- docSharedWrapper layoutExpr exp1 - expDoc2 <- docSharedWrapper layoutExpr exp2 - docAlt - [ -- func arg - docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2] - , -- func argline1 - -- arglines - -- e.g. - -- func if x - -- then 1 - -- else 2 - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docSeq - [ appSep $ docForceSingleline expDoc1 - , docForceParSpacing expDoc2 - ] - , -- func - -- arg - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docForceSingleline expDoc1) - (docNonBottomSpacing expDoc2) - , -- fu - -- nc - -- ar - -- gument - docAddBaseY BrIndentRegular - $ docPar - expDoc1 - expDoc2 - ] + HsLam{} -> + unknownNodeError "HsLam too complex" lexpr #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsAppType exp1 (HsWC _ ty1) -> do + HsLamCase (MG lmatches@(L _ matches) _ _ _) -> do #else /* ghc-8.0 */ - HsAppType exp1 (HsWC _ _ ty1) -> do + HsLamCase _ (MG lmatches@(L _ matches) _ _ _) -> do #endif - t <- docSharedWrapper layoutType ty1 - e <- docSharedWrapper layoutExpr exp1 - docAlt - [ docSeq - [ docForceSingleline e - , docSeparator - , docLit $ Text.pack "@" - , docForceSingleline t - ] - , docPar - e - (docSeq [docLit $ Text.pack "@", t ]) - ] - HsAppTypeOut{} -> do - -- TODO - briDocByExactInlineOnly "HsAppTypeOut{}" lexpr - OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do - let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)]) - gather opExprList = \case - (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1 - final -> (final, opExprList) - (leftOperand, appList) = gather [] expLeft - leftOperandDoc <- docSharedWrapper layoutExpr leftOperand - appListDocs <- appList `forM` \(x,y) -> [ (xD, yD) - | xD <- docSharedWrapper layoutExpr x - , yD <- docSharedWrapper layoutExpr y - ] - opLastDoc <- docSharedWrapper layoutExpr expOp - expLastDoc <- docSharedWrapper layoutExpr expRight - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True - docAlt - [ docSeq - [ appSep $ docForceSingleline leftOperandDoc - , docSeq - $ (appListDocs <&> \(od, ed) -> docSeq - [ appSep $ docForceSingleline od - , appSep $ docForceSingleline ed - ] - ) - , appSep $ docForceSingleline opLastDoc - , (if allowPar then docForceParSpacing else docForceSingleline) - expLastDoc - ] - -- this case rather leads to some unfortunate layouting than to anything - -- useful; disabling for now. (it interfers with cols stuff.) - -- , docSetBaseY - -- - $ docPar - -- leftOperandDoc - -- ( docLines - -- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) - -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] - -- ) - , docPar - leftOperandDoc - ( docLines - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) - ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] - ) - ] - OpApp expLeft expOp _ expRight -> do - expDocLeft <- docSharedWrapper layoutExpr expLeft - expDocOp <- docSharedWrapper layoutExpr expOp - expDocRight <- docSharedWrapper layoutExpr expRight - let allowPar = case (expOp, expRight) of - (L _ (HsVar (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ (L _ HsVar{}))) -> False - _ -> True - docAltFilter - $ [ -- one-line - (,) True - $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceSingleline expDocRight - ] - -- , -- line + freely indented block for right expression - -- docSeq - -- [ appSep $ docForceSingleline expDocLeft - -- , appSep $ docForceSingleline expDocOp - -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight - -- ] - , -- two-line - (,) True + binderDoc <- docLit $ Text.pack "->" + funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches + docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "\\case") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) + HsApp exp1@(L _ HsApp{}) exp2 -> do + let gather :: [LHsExpr RdrName] -> LHsExpr RdrName -> (LHsExpr RdrName, [LHsExpr RdrName]) + gather list = \case + (L _ (HsApp l r)) -> gather (r:list) l + x -> (x, list) + let (headE, paramEs) = gather [exp2] exp1 + headDoc <- docSharedWrapper layoutExpr headE + paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs + docAlt + [ -- foo x y + docCols ColApp + $ appSep (docForceSingleline headDoc) + : spacifyDocs (docForceSingleline <$> paramDocs) + , -- foo x + -- y + docSeq + [ appSep (docForceSingleline headDoc) + , docSetBaseY $ docAddBaseY BrIndentRegular - $ docPar - expDocLeft - ( docForceSingleline - $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] - ) - , -- one-line + par - (,) allowPar - $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceParSpacing expDocRight + $ docLines + $ (docForceSingleline <$> paramDocs) + ] + , -- foo + -- x + -- y + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docForceSingleline headDoc) + ( docNonBottomSpacing + $ docLines paramDocs + ) + , -- ( multi + -- line + -- function + -- ) + -- x + -- y + docAddBaseY BrIndentRegular + $ docPar + headDoc + ( docNonBottomSpacing + $ docLines paramDocs + ) + ] + HsApp exp1 exp2 -> do + -- TODO: if expDoc1 is some literal, we may want to create a docCols here. + expDoc1 <- docSharedWrapper layoutExpr exp1 + expDoc2 <- docSharedWrapper layoutExpr exp2 + docAlt + [ -- func arg + docSeq [appSep $ docForceSingleline expDoc1, docForceSingleline expDoc2] + , -- func argline1 + -- arglines + -- e.g. + -- func if x + -- then 1 + -- else 2 + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docSeq + [ appSep $ docForceSingleline expDoc1 + , docForceParSpacing expDoc2 + ] + , -- func + -- arg + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docForceSingleline expDoc1) + (docNonBottomSpacing expDoc2) + , -- fu + -- nc + -- ar + -- gument + docAddBaseY BrIndentRegular + $ docPar + expDoc1 + expDoc2 + ] +#if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ + HsAppType exp1 (HsWC _ ty1) -> do +#else /* ghc-8.0 */ + HsAppType exp1 (HsWC _ _ ty1) -> do +#endif + t <- docSharedWrapper layoutType ty1 + e <- docSharedWrapper layoutExpr exp1 + docAlt + [ docSeq + [ docForceSingleline e + , docSeparator + , docLit $ Text.pack "@" + , docForceSingleline t ] - , -- more lines - (,) True - $ docAddBaseY BrIndentRegular - $ docPar - expDocLeft - (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) + , docPar + e + (docSeq [docLit $ Text.pack "@", t ]) + ] + HsAppTypeOut{} -> do + -- TODO + briDocByExactInlineOnly "HsAppTypeOut{}" lexpr + OpApp expLeft@(L _ OpApp{}) expOp _ expRight -> do + let gather :: [(LHsExpr RdrName, LHsExpr RdrName)] -> LHsExpr RdrName -> (LHsExpr RdrName, [(LHsExpr RdrName, LHsExpr RdrName)]) + gather opExprList = \case + (L _ (OpApp l1 op1 _ r1)) -> gather ((op1, r1): opExprList) l1 + final -> (final, opExprList) + (leftOperand, appList) = gather [] expLeft + leftOperandDoc <- docSharedWrapper layoutExpr leftOperand + appListDocs <- appList `forM` \(x,y) -> [ (xD, yD) + | xD <- docSharedWrapper layoutExpr x + , yD <- docSharedWrapper layoutExpr y + ] + opLastDoc <- docSharedWrapper layoutExpr expOp + expLastDoc <- docSharedWrapper layoutExpr expRight + let allowPar = case (expOp, expRight) of + (L _ (HsVar (L _ (Unqual occname))), _) + | occNameString occname == "$" -> True + (_, L _ (HsApp _ (L _ HsVar{}))) -> False + _ -> True + docAlt + [ docSeq + [ appSep $ docForceSingleline leftOperandDoc + , docSeq + $ (appListDocs <&> \(od, ed) -> docSeq + [ appSep $ docForceSingleline od + , appSep $ docForceSingleline ed + ] + ) + , appSep $ docForceSingleline opLastDoc + , (if allowPar then docForceParSpacing else docForceSingleline) + expLastDoc ] - NegApp op _ -> do - opDoc <- docSharedWrapper layoutExpr op - docSeq $ [ docLit $ Text.pack "-" - , opDoc - ] - HsPar innerExp -> do - innerExpDoc <- docSharedWrapper layoutExpr innerExp - docAlt - [ docSeq - [ docLit $ Text.pack "(" - , docForceSingleline innerExpDoc - , docLit $ Text.pack ")" + -- this case rather leads to some unfortunate layouting than to anything + -- useful; disabling for now. (it interfers with cols stuff.) + -- , docSetBaseY + -- - $ docPar + -- leftOperandDoc + -- ( docLines + -- - $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) + -- ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] + -- ) + , docPar + leftOperandDoc + ( docLines + $ (appListDocs <&> \(od, ed) -> docCols ColOpPrefix [appSep od, docSetBaseY ed]) + ++ [docCols ColOpPrefix [appSep opLastDoc, docSetBaseY expLastDoc]] + ) ] - , docSetBaseY $ docLines - [ docCols ColOpPrefix - [ docParenLSep - , docAddBaseY (BrIndentSpecial 2) innerExpDoc - ] - , docLit $ Text.pack ")" - ] - ] - SectionL left op -> do -- TODO: add to testsuite - leftDoc <- docSharedWrapper layoutExpr left - opDoc <- docSharedWrapper layoutExpr op - docSeq [leftDoc, opDoc] - SectionR op right -> do -- TODO: add to testsuite - opDoc <- docSharedWrapper layoutExpr op - rightDoc <- docSharedWrapper layoutExpr right - docSeq [opDoc, rightDoc] - ExplicitTuple args boxity - | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do - argDocs <- docSharedWrapper layoutExpr `mapM` argExprs - hasComments <- hasAnyCommentsBelow lexpr - let (openLit, closeLit) = case boxity of - Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") - Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)") - case splitFirstLast argDocs of - FirstLastEmpty -> docSeq - [ openLit - , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit - ] - FirstLastSingleton e -> docAlt - [ docCols ColTuple - [ openLit - , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e - , closeLit + OpApp expLeft expOp _ expRight -> do + expDocLeft <- docSharedWrapper layoutExpr expLeft + expDocOp <- docSharedWrapper layoutExpr expOp + expDocRight <- docSharedWrapper layoutExpr expRight + let allowPar = case (expOp, expRight) of + (L _ (HsVar (L _ (Unqual occname))), _) + | occNameString occname == "$" -> True + (_, L _ (HsApp _ (L _ HsVar{}))) -> False + _ -> True + docAltFilter + $ [ -- one-line + (,) True + $ docSeq + [ appSep $ docForceSingleline expDocLeft + , appSep $ docForceSingleline expDocOp + , docForceSingleline expDocRight + ] + -- , -- line + freely indented block for right expression + -- docSeq + -- [ appSep $ docForceSingleline expDocLeft + -- , appSep $ docForceSingleline expDocOp + -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight + -- ] + , -- two-line + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + expDocLeft + ( docForceSingleline + $ docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight] + ) + , -- one-line + par + (,) allowPar + $ docSeq + [ appSep $ docForceSingleline expDocLeft + , appSep $ docForceSingleline expDocOp + , docForceParSpacing expDocRight + ] + , -- more lines + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + expDocLeft + (docCols ColOpPrefix [appSep $ expDocOp, docSetBaseY expDocRight]) + ] + NegApp op _ -> do + opDoc <- docSharedWrapper layoutExpr op + docSeq $ [ docLit $ Text.pack "-" + , opDoc + ] + HsPar innerExp -> do + innerExpDoc <- docSharedWrapper layoutExpr innerExp + docAlt + [ docSeq + [ docLit $ Text.pack "(" + , docForceSingleline innerExpDoc + , docLit $ Text.pack ")" ] , docSetBaseY $ docLines - [ docSeq + [ docCols ColOpPrefix + [ docParenLSep + , docAddBaseY (BrIndentSpecial 2) innerExpDoc + ] + , docLit $ Text.pack ")" + ] + ] + SectionL left op -> do -- TODO: add to testsuite + leftDoc <- docSharedWrapper layoutExpr left + opDoc <- docSharedWrapper layoutExpr op + docSeq [leftDoc, opDoc] + SectionR op right -> do -- TODO: add to testsuite + opDoc <- docSharedWrapper layoutExpr op + rightDoc <- docSharedWrapper layoutExpr right + docSeq [opDoc, rightDoc] + ExplicitTuple args boxity + | Just argExprs <- args `forM` (\case (L _ (Present e)) -> Just e; _ -> Nothing) -> do + argDocs <- docSharedWrapper layoutExpr `mapM` argExprs + hasComments <- hasAnyCommentsBelow lexpr + let (openLit, closeLit) = case boxity of + Boxed -> (docLit $ Text.pack "(", docLit $ Text.pack ")") + Unboxed -> (docLit $ Text.pack "(#", docLit $ Text.pack "#)") + case splitFirstLast argDocs of + FirstLastEmpty -> docSeq + [ openLit + , docNodeAnnKW lexpr (Just AnnOpenP) $ closeLit + ] + FirstLastSingleton e -> docAlt + [ docCols ColTuple [ openLit , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e + , closeLit + ] + , docSetBaseY $ docLines + [ docSeq + [ openLit + , docNodeAnnKW lexpr (Just AnnOpenP) $ docForceSingleline e + ] + , closeLit ] - , closeLit ] - ] - FirstLast e1 ems eN -> - docAltFilter - [ (,) (not hasComments) - $ docCols ColTuple - ( [docSeq [openLit, docForceSingleline e1]] - ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e]) - ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]] + FirstLast e1 ems eN -> + docAltFilter + [ (,) (not hasComments) + $ docCols ColTuple + ( [docSeq [openLit, docForceSingleline e1]] + ++ (ems <&> \e -> docSeq [docCommaSep, docForceSingleline e]) + ++ [docSeq [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) (docForceSingleline eN), closeLit]] + ) + , (,) True + $ let + start = docCols ColTuples + [appSep $ openLit, e1] + linesM = ems <&> \d -> + docCols ColTuples [docCommaSep, d] + lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] + end = closeLit + in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] + ] + ExplicitTuple{} -> + unknownNodeError "ExplicitTuple|.." lexpr + HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do + cExpDoc <- docSharedWrapper layoutExpr cExp + binderDoc <- docLit $ Text.pack "->" + funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches + docAlt + [ docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + ( docSeq + [ appSep $ docLit $ Text.pack "case" + , appSep $ docForceSingleline cExpDoc + , docLit $ Text.pack "of" + ]) + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) + , docPar + ( docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "case") cExpDoc + ) + ( docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "of") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) ) - , (,) True - $ let - start = docCols ColTuples - [appSep $ openLit, e1] - linesM = ems <&> \d -> - docCols ColTuples [docCommaSep, d] - lineN = docCols ColTuples [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenP) eN] - end = closeLit - in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] - ] - ExplicitTuple{} -> - unknownNodeError "ExplicitTuple|.." lexpr - HsCase cExp (MG lmatches@(L _ matches) _ _ _) -> do - cExpDoc <- docSharedWrapper layoutExpr cExp - binderDoc <- docLit $ Text.pack "->" - funcPatDocs <- docWrapNode lmatches $ layoutPatternBind Nothing binderDoc `mapM` matches - docAlt - [ docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - ( docSeq - [ appSep $ docLit $ Text.pack "case" - , appSep $ docForceSingleline cExpDoc - , docLit $ Text.pack "of" - ]) - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - , docPar - ( docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "case") cExpDoc - ) - ( docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "of") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines $ return <$> funcPatDocs) - ) - ] - HsIf _ ifExpr thenExpr elseExpr -> do - ifExprDoc <- docSharedWrapper layoutExpr ifExpr - thenExprDoc <- docSharedWrapper layoutExpr thenExpr - elseExprDoc <- docSharedWrapper layoutExpr elseExpr - hasComments <- hasAnyCommentsBelow lexpr - docAltFilter - [ -- if _ then _ else _ - (,) (not hasComments) - $ docSeq - [ appSep $ docLit $ Text.pack "if" - , appSep $ docForceSingleline ifExprDoc - , appSep $ docLit $ Text.pack "then" - , appSep $ docForceSingleline thenExprDoc - , appSep $ docLit $ Text.pack "else" - , docForceSingleline elseExprDoc ] - , -- either - -- if expr - -- then foo - -- bar - -- else foo - -- bar - -- or - -- if expr - -- then - -- stuff - -- else - -- stuff - -- note that this has par-spacing - (,) True - $ docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - ( docAddBaseY (BrIndentSpecial 3) - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" - , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc - ]) - (docLines - [ docAddBaseY BrIndentRegular - $ docNodeAnnKW lexpr (Just AnnThen) - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + HsIf _ ifExpr thenExpr elseExpr -> do + ifExprDoc <- docSharedWrapper layoutExpr ifExpr + thenExprDoc <- docSharedWrapper layoutExpr thenExpr + elseExprDoc <- docSharedWrapper layoutExpr elseExpr + hasComments <- hasAnyCommentsBelow lexpr + docAltFilter + [ -- if _ then _ else _ + (,) (not hasComments) + $ docSeq + [ appSep $ docLit $ Text.pack "if" + , appSep $ docForceSingleline ifExprDoc + , appSep $ docLit $ Text.pack "then" + , appSep $ docForceSingleline thenExprDoc + , appSep $ docLit $ Text.pack "else" + , docForceSingleline elseExprDoc + ] + , -- either + -- if expr + -- then foo + -- bar + -- else foo + -- bar + -- or + -- if expr + -- then + -- stuff + -- else + -- stuff + -- note that this has par-spacing + (,) True + $ docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + ( docAddBaseY (BrIndentSpecial 3) + $ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" + , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc + ]) + (docLines + [ docAddBaseY BrIndentRegular + $ docNodeAnnKW lexpr (Just AnnThen) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + ] , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - ] - , docAddBaseY BrIndentRegular - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc + ] + ]) + , -- either + -- if multi + -- line + -- condition + -- then foo + -- bar + -- else foo + -- bar + -- or + -- if multi + -- line + -- condition + -- then + -- stuff + -- else + -- stuff + -- note that this does _not_ have par-spacing + (,) True + $ docAddBaseY BrIndentRegular + $ docPar + ( docAddBaseY (BrIndentSpecial 3) + $ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" + , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc + ]) + (docLines + [ docAddBaseY BrIndentRegular + $ docNodeAnnKW lexpr (Just AnnThen) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + ] , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc - ] - ]) - , -- either - -- if multi - -- line - -- condition - -- then foo - -- bar - -- else foo - -- bar - -- or - -- if multi - -- line - -- condition - -- then - -- stuff - -- else - -- stuff - -- note that this does _not_ have par-spacing - (,) True - $ docAddBaseY BrIndentRegular - $ docPar - ( docAddBaseY (BrIndentSpecial 3) + $ docAlt + [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc + ] + ]) + , (,) True + $ docSetBaseY + $ docLines + [ docAddBaseY (BrIndentSpecial 3) $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc - ]) - (docLines + ] + , docNodeAnnKW lexpr (Just AnnThen) + $ docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "then") thenExprDoc + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "else") elseExprDoc + ] + ] + HsMultiIf _ cases -> do + clauseDocs <- cases `forM` layoutGrhs + binderDoc <- docLit $ Text.pack "->" + hasComments <- hasAnyCommentsBelow lexpr + docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "if") + (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) + HsLet binds exp1 -> do + expDoc1 <- docSharedWrapper layoutExpr exp1 + mBindDocs <- layoutLocalBinds binds + -- this `docSetIndentLevel` might seem out of place, but is here due to + -- ghc-exactprint's DP handling of "let" in particular. + -- Just pushing another indentation level is a straightforward approach + -- to making brittany idempotent, even though the result is non-optimal + -- if "let" is moved horizontally as part of the transformation, as the + -- comments before the first let item are moved horizontally with it. + docSetIndentLevel $ case mBindDocs of + Just [bindDoc] -> docAlt + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , appSep $ docForceSingleline $ return bindDoc + , appSep $ docLit $ Text.pack "in" + , docForceSingleline $ expDoc1 + ] + , docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ return bindDoc + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + , docLines [ docAddBaseY BrIndentRegular - $ docNodeAnnKW lexpr (Just AnnThen) - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "then", docForceParSpacing thenExprDoc] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - ] + $ docPar + (appSep $ docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) , docAddBaseY BrIndentRegular - $ docAlt - [ docSeq [appSep $ docLit $ Text.pack "else", docForceParSpacing elseExprDoc] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc + $ docPar + (appSep $ docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] + ] + Just bindDocs@(_:_) -> docAlt + [ docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs ] - ]) - , (,) True - $ docSetBaseY - $ docLines - [ docAddBaseY (BrIndentSpecial 3) - $ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" - , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] ] - , docNodeAnnKW lexpr (Just AnnThen) + _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] + -- docSeq [appSep $ docLit "let in", expDoc1] + HsDo DoExpr (L _ stmts) _ -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + docSetParSpacing $ docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "then") thenExprDoc - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "else") elseExprDoc - ] - ] - HsMultiIf _ cases -> do - clauseDocs <- cases `forM` layoutGrhs - binderDoc <- docLit $ Text.pack "->" - hasComments <- hasAnyCommentsBelow lexpr - docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "if") - (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments) - HsLet binds exp1 -> do - expDoc1 <- docSharedWrapper layoutExpr exp1 - mBindDocs <- layoutLocalBinds binds - -- this `docSetIndentLevel` might seem out of place, but is here due to - -- ghc-exactprint's DP handling of "let" in particular. - -- Just pushing another indentation level is a straightforward approach - -- to making brittany idempotent, even though the result is non-optimal - -- if "let" is moved horizontally as part of the transformation, as the - -- comments before the first let item are moved horizontally with it. - docSetIndentLevel $ case mBindDocs of - Just [bindDoc] -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , appSep $ docForceSingleline $ return bindDoc - , appSep $ docLit $ Text.pack "in" - , docForceSingleline $ expDoc1 - ] - , docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 - ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - , docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) + $ docPar + (docLit $ Text.pack "do") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) + HsDo MDoExpr (L _ stmts) _ -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "mdo") + (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) + HsDo x (L _ stmts) _ | case x of { ListComp -> True + ; MonadComp -> True + ; _ -> False } -> do + stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts + hasComments <- hasAnyCommentsBelow lexpr + docAltFilter + [ (,) (not hasComments) + $ docSeq + [ docNodeAnnKW lexpr Nothing + $ appSep + $ docLit + $ Text.pack "[" + , docNodeAnnKW lexpr (Just AnnOpenS) + $ appSep + $ docForceSingleline + $ List.last stmtDocs + , appSep $ docLit $ Text.pack "|" + , docSeq $ List.intersperse docCommaSep + $ fmap docForceSingleline $ List.init stmtDocs + , docLit $ Text.pack " ]" ] + , (,) True + $ let + start = docCols ColListComp + [ docNodeAnnKW lexpr Nothing + $ appSep $ docLit $ Text.pack "[" + , docSetBaseY + $ docNodeAnnKW lexpr (Just AnnOpenS) + $ List.last stmtDocs + ] + (s1:sM) = List.init stmtDocs + line1 = docCols ColListComp + [appSep $ docLit $ Text.pack "|", s1] + lineM = sM <&> \d -> + docCols ColListComp [docCommaSep, d] + end = docLit $ Text.pack "]" + in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] ] - Just bindDocs@(_:_) -> docAlt - [ docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 - ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) - ] - ] - _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] - -- docSeq [appSep $ docLit "let in", expDoc1] - HsDo DoExpr (L _ stmts) _ -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "do") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) - HsDo MDoExpr (L _ stmts) _ -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "mdo") - (docSetBaseAndIndent $ docNonBottomSpacing $ docLines stmtDocs) - HsDo x (L _ stmts) _ | case x of { ListComp -> True - ; MonadComp -> True - ; _ -> False } -> do - stmtDocs <- docSharedWrapper layoutStmt `mapM` stmts - hasComments <- hasAnyCommentsBelow lexpr - docAltFilter - [ (,) (not hasComments) - $ docSeq - [ docNodeAnnKW lexpr Nothing - $ appSep - $ docLit - $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) - $ appSep - $ docForceSingleline - $ List.last stmtDocs - , appSep $ docLit $ Text.pack "|" - , docSeq $ List.intersperse docCommaSep - $ fmap docForceSingleline $ List.init stmtDocs - , docLit $ Text.pack " ]" - ] - , (,) True - $ let - start = docCols ColListComp - [ docNodeAnnKW lexpr Nothing - $ appSep $ docLit $ Text.pack "[" - , docSetBaseY - $ docNodeAnnKW lexpr (Just AnnOpenS) - $ List.last stmtDocs - ] - (s1:sM) = List.init stmtDocs - line1 = docCols ColListComp - [appSep $ docLit $ Text.pack "|", s1] - lineM = sM <&> \d -> - docCols ColListComp [docCommaSep, d] - end = docLit $ Text.pack "]" - in docSetBaseY $ docLines $ [start, line1] ++ lineM ++ [end] - ] - HsDo{} -> do - -- TODO - unknownNodeError "HsDo{} no comp" lexpr - ExplicitList _ _ elems@(_:_) -> do - elemDocs <- elems `forM` docSharedWrapper layoutExpr - hasComments <- hasAnyCommentsBelow lexpr - case splitFirstLast elemDocs of - FirstLastEmpty -> docSeq - [ docLit $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]" - ] - FirstLastSingleton e -> docAlt - [ docSeq + HsDo{} -> do + -- TODO + unknownNodeError "HsDo{} no comp" lexpr + ExplicitList _ _ elems@(_:_) -> do + elemDocs <- elems `forM` docSharedWrapper layoutExpr + hasComments <- hasAnyCommentsBelow lexpr + case splitFirstLast elemDocs of + FirstLastEmpty -> docSeq [ docLit $ Text.pack "[" - , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e - , docLit $ Text.pack "]" + , docNodeAnnKW lexpr (Just AnnOpenS) $ docLit $ Text.pack "]" ] - , docSetBaseY $ docLines + FirstLastSingleton e -> docAlt [ docSeq [ docLit $ Text.pack "[" - , docSeparator - , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e + , docNodeAnnKW lexpr (Just AnnOpenS) $ docForceSingleline e + , docLit $ Text.pack "]" + ] + , docSetBaseY $ docLines + [ docSeq + [ docLit $ Text.pack "[" + , docSeparator + , docSetBaseY $ docNodeAnnKW lexpr (Just AnnOpenS) $ e + ] + , docLit $ Text.pack "]" ] - , docLit $ Text.pack "]" ] - ] - FirstLast e1 ems eN -> - docAltFilter - [ (,) (not hasComments) - $ docSeq - $ [docLit $ Text.pack "["] - ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) - ++ [docLit $ Text.pack "]"] - , (,) True - $ let - start = docCols ColList - [appSep $ docLit $ Text.pack "[", e1] - linesM = ems <&> \d -> - docCols ColList [docCommaSep, d] - lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] - end = docLit $ Text.pack "]" - in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] - ] - ExplicitList _ _ [] -> - docLit $ Text.pack "[]" - ExplicitPArr{} -> do - -- TODO - briDocByExactInlineOnly "ExplicitPArr{}" lexpr - RecordCon lname _ _ (HsRecFields [] Nothing) -> do - let t = lrdrNameToText lname - docWrapNode lname $ docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" - , docLit $ Text.pack "}" - ] - RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do - let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname - ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do - fExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr fExpr - return $ (fieldl, lrdrNameToText lnameF, fExpDoc) - let line1 appender wrapper = - [ appender $ 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 lineN = - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - docAlt - [ docSeq - $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] - ++ line1 id docForceSingleline - ++ join (lineR docForceSingleline) - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineN] - ) - ] - RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do - let t = lrdrNameToText lname - docWrapNode lname $ docLit $ t <> Text.pack " {..}" - RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do - let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname - ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do - fExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr fExpr - return $ (fieldl, lrdrNameToText lnameF, fExpDoc) - let line1 appender wrapper = - [ appender $ 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 - [ docSeq - $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] - ++ line1 id docForceSingleline - ++ join (lineR docForceSingleline) - ++ lineDot - ++ lineN - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ nameDoc) - ( docNonBottomSpacing - $ docLines - $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] - ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) - ++ [docSeq lineDot, docSeq lineN] - ) - ] - RecordCon{} -> - unknownNodeError "RecordCon with puns" lexpr - RecordUpd rExpr [] _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - docSeq [rExprDoc, docLit $ Text.pack "{}"] - RecordUpd rExpr fields@(_:_) _ _ _ _ -> do - rExprDoc <- docSharedWrapper layoutExpr rExpr - rFs@((rF1f, rF1n, rF1e):rFr) <- fields - `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do - rFExpDoc <- if pun - then return Nothing - else Just <$> docSharedWrapper layoutExpr rFExpr - return $ case ambName of - Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - docAlt - -- singleline - [ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc - , appSep $ docLit $ Text.pack "{" - , appSep $ docSeq $ List.intersperse docCommaSep - $ rFs <&> \case - (lfield, fieldStr, Just fieldDoc) -> - docWrapNode lfield $ docSeq - [ appSep $ docLit fieldStr - , appSep $ docLit $ Text.pack "=" - , docForceSingleline fieldDoc - ] - (lfield, fieldStr, Nothing) -> - docWrapNode lfield $ docLit fieldStr + FirstLast e1 ems eN -> + docAltFilter + [ (,) (not hasComments) + $ docSeq + $ [docLit $ Text.pack "["] + ++ List.intersperse docCommaSep (docForceSingleline <$> (e1:ems ++ [docNodeAnnKW lexpr (Just AnnOpenS) eN])) + ++ [docLit $ Text.pack "]"] + , (,) True + $ let + start = docCols ColList + [appSep $ docLit $ Text.pack "[", e1] + linesM = ems <&> \d -> + docCols ColList [docCommaSep, d] + lineN = docCols ColList [docCommaSep, docNodeAnnKW lexpr (Just AnnOpenS) eN] + end = docLit $ Text.pack "]" + in docSetBaseY $ docLines $ [start] ++ linesM ++ [lineN] ++ [end] + ] + ExplicitList _ _ [] -> + docLit $ Text.pack "[]" + ExplicitPArr{} -> do + -- TODO + briDocByExactInlineOnly "ExplicitPArr{}" lexpr + RecordCon lname _ _ (HsRecFields [] Nothing) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) $ docLit $ t <> Text.pack "{" , docLit $ Text.pack "}" ] - -- wild-indentation block - , docSeq - [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc - , docSetBaseY $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , case rF1e of - Just x -> docWrapNodeRest rF1f $ docSeq - [ appSep $ docLit $ Text.pack "=" - , docForceSingleline $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docForceSingleline x - ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] + RecordCon lname _ _ (HsRecFields fs@(_:_) Nothing) -> do + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do + fExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr fExpr + return $ (fieldl, lrdrNameToText lnameF, fExpDoc) + let line1 appender wrapper = + [ appender $ 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 lineN = + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + docAlt + [ docSeq + $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] + ++ line1 id docForceSingleline + ++ join (lineR docForceSingleline) + ++ lineN + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ nameDoc) + ( docNonBottomSpacing + $ docLines + $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineN] + ) + ] + RecordCon lname _ _ (HsRecFields [] (Just 0)) -> do + let t = lrdrNameToText lname + docWrapNode lname $ docLit $ t <> Text.pack " {..}" + RecordCon lname _ _ (HsRecFields fs@(_:_) (Just dotdoti)) | dotdoti == length fs -> do + let nameDoc = docWrapNode lname $ docLit $ lrdrNameToText lname + ((fd1l, fd1n, fd1e):fdr) <- fs `forM` \fieldl@(L _ (HsRecField (L _ (FieldOcc lnameF _)) fExpr pun)) -> do + fExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr fExpr + return $ (fieldl, lrdrNameToText lnameF, fExpDoc) + let line1 appender wrapper = + [ appender $ 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 + [ docSeq + $ [docNodeAnnKW lexpr Nothing $ nameDoc, docSeparator] + ++ line1 id docForceSingleline + ++ join (lineR docForceSingleline) + ++ lineDot + ++ lineN + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ nameDoc) + ( docNonBottomSpacing + $ docLines + $ [docCols ColRecUpdate $ line1 appSep (docAddBaseY BrIndentRegular)] + ++ (docCols ColRecUpdate <$> lineR (docAddBaseY BrIndentRegular)) + ++ [docSeq lineDot, docSeq lineN] + ) + ] + RecordCon{} -> + unknownNodeError "RecordCon with puns" lexpr + RecordUpd rExpr [] _ _ _ _ -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + docSeq [rExprDoc, docLit $ Text.pack "{}"] + RecordUpd rExpr fields@(_:_) _ _ _ _ -> do + rExprDoc <- docSharedWrapper layoutExpr rExpr + rFs@((rF1f, rF1n, rF1e):rFr) <- fields + `forM` \lfield@(L _ (HsRecField (L _ ambName) rFExpr pun)) -> do + rFExpDoc <- if pun + then return Nothing + else Just <$> docSharedWrapper layoutExpr rFExpr + return $ case ambName of + Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) + Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) + docAlt + -- singleline + [ docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc + , appSep $ docLit $ Text.pack "{" + , appSep $ docSeq $ List.intersperse docCommaSep + $ rFs <&> \case + (lfield, fieldStr, Just fieldDoc) -> + docWrapNode lfield $ docSeq + [ appSep $ docLit fieldStr + , appSep $ docLit $ Text.pack "=" + , docForceSingleline fieldDoc + ] + (lfield, fieldStr, Nothing) -> + docWrapNode lfield $ docLit fieldStr + , docLit $ Text.pack "}" + ] + -- wild-indentation block + , docSeq + [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc + , docSetBaseY $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , case rF1e of + Just x -> docWrapNodeRest rF1f $ docSeq + [ appSep $ docLit $ Text.pack "=" + , docForceSingleline $ x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docForceSingleline x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN] + ] + -- strict indentation block + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ rExprDoc) + (docNonBottomSpacing $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , docWrapNodeRest rF1f $ case rF1e of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular $ x + ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN]) ] - -- strict indentation block - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ rExprDoc) - (docNonBottomSpacing $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , docWrapNodeRest rF1f $ case rF1e of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular x - ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN]) - ] #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do + ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do #else /* ghc-8.0 */ - ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do + ExprWithTySig exp1 (HsIB _ (HsWC _ _ typ1)) -> do #endif - expDoc <- docSharedWrapper layoutExpr exp1 - typDoc <- docSharedWrapper layoutType typ1 - docSeq - [ appSep expDoc - , appSep $ docLit $ Text.pack "::" - , typDoc - ] - ExprWithTySigOut{} -> do - -- TODO - briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr - ArithSeq _ Nothing info -> - case info of - From e1 -> do - e1Doc <- docSharedWrapper layoutExpr e1 - docSeq - [ docLit $ Text.pack "[" - , appSep $ docForceSingleline e1Doc - , docLit $ Text.pack "..]" - ] - FromThen e1 e2 -> do - e1Doc <- docSharedWrapper layoutExpr e1 - e2Doc <- docSharedWrapper layoutExpr e2 - docSeq - [ docLit $ Text.pack "[" - , docForceSingleline e1Doc - , docCommaSep - , appSep $ docForceSingleline e2Doc - , docLit $ Text.pack "..]" - ] - FromTo e1 eN -> do - e1Doc <- docSharedWrapper layoutExpr e1 - eNDoc <- docSharedWrapper layoutExpr eN - docSeq - [ docLit $ Text.pack "[" - , appSep $ docForceSingleline e1Doc - , appSep $ docLit $ Text.pack ".." - , docForceSingleline eNDoc - , docLit $ Text.pack "]" - ] - FromThenTo e1 e2 eN -> do - e1Doc <- docSharedWrapper layoutExpr e1 - e2Doc <- docSharedWrapper layoutExpr e2 - eNDoc <- docSharedWrapper layoutExpr eN - docSeq - [ docLit $ Text.pack "[" - , docForceSingleline e1Doc - , docCommaSep - , appSep $ docForceSingleline e2Doc - , appSep $ docLit $ Text.pack ".." - , docForceSingleline eNDoc - , docLit $ Text.pack "]" - ] - ArithSeq{} -> - briDocByExactInlineOnly "ArithSeq" lexpr - PArrSeq{} -> do - -- TODO - briDocByExactInlineOnly "PArrSeq{}" lexpr - HsSCC{} -> do - -- TODO - briDocByExactInlineOnly "HsSCC{}" lexpr - HsCoreAnn{} -> do - -- TODO - briDocByExactInlineOnly "HsCoreAnn{}" lexpr - HsBracket{} -> do - -- TODO - briDocByExactInlineOnly "HsBracket{}" lexpr - HsRnBracketOut{} -> do - -- TODO - briDocByExactInlineOnly "HsRnBracketOut{}" lexpr - HsTcBracketOut{} -> do - -- TODO - briDocByExactInlineOnly "HsTcBracketOut{}" lexpr - HsSpliceE{} -> do - -- TODO - briDocByExactInlineOnly "HsSpliceE{}" lexpr - HsProc{} -> do - -- TODO - briDocByExactInlineOnly "HsProc{}" lexpr - HsStatic{} -> do - -- TODO - briDocByExactInlineOnly "HsStatic{}" lexpr - HsArrApp{} -> do - -- TODO - briDocByExactInlineOnly "HsArrApp{}" lexpr - HsArrForm{} -> do - -- TODO - briDocByExactInlineOnly "HsArrForm{}" lexpr - HsTick{} -> do - -- TODO - briDocByExactInlineOnly "HsTick{}" lexpr - HsBinTick{} -> do - -- TODO - briDocByExactInlineOnly "HsBinTick{}" lexpr - HsTickPragma{} -> do - -- TODO - briDocByExactInlineOnly "HsTickPragma{}" lexpr - EWildPat{} -> do - docLit $ Text.pack "_" - EAsPat asName asExpr -> do - docSeq - [ docLit $ (lrdrNameToText asName) <> Text.pack "@" - , layoutExpr asExpr - ] - EViewPat{} -> do - -- TODO - briDocByExactInlineOnly "EViewPat{}" lexpr - ELazyPat{} -> do - -- TODO - briDocByExactInlineOnly "ELazyPat{}" lexpr - HsWrap{} -> do - -- TODO - briDocByExactInlineOnly "HsWrap{}" lexpr + expDoc <- docSharedWrapper layoutExpr exp1 + typDoc <- docSharedWrapper layoutType typ1 + docSeq + [ appSep expDoc + , appSep $ docLit $ Text.pack "::" + , typDoc + ] + ExprWithTySigOut{} -> do + -- TODO + briDocByExactInlineOnly "ExprWithTySigOut{}" lexpr + ArithSeq _ Nothing info -> + case info of + From e1 -> do + e1Doc <- docSharedWrapper layoutExpr e1 + docSeq + [ docLit $ Text.pack "[" + , appSep $ docForceSingleline e1Doc + , docLit $ Text.pack "..]" + ] + FromThen e1 e2 -> do + e1Doc <- docSharedWrapper layoutExpr e1 + e2Doc <- docSharedWrapper layoutExpr e2 + docSeq + [ docLit $ Text.pack "[" + , docForceSingleline e1Doc + , docCommaSep + , appSep $ docForceSingleline e2Doc + , docLit $ Text.pack "..]" + ] + FromTo e1 eN -> do + e1Doc <- docSharedWrapper layoutExpr e1 + eNDoc <- docSharedWrapper layoutExpr eN + docSeq + [ docLit $ Text.pack "[" + , appSep $ docForceSingleline e1Doc + , appSep $ docLit $ Text.pack ".." + , docForceSingleline eNDoc + , docLit $ Text.pack "]" + ] + FromThenTo e1 e2 eN -> do + e1Doc <- docSharedWrapper layoutExpr e1 + e2Doc <- docSharedWrapper layoutExpr e2 + eNDoc <- docSharedWrapper layoutExpr eN + docSeq + [ docLit $ Text.pack "[" + , docForceSingleline e1Doc + , docCommaSep + , appSep $ docForceSingleline e2Doc + , appSep $ docLit $ Text.pack ".." + , docForceSingleline eNDoc + , docLit $ Text.pack "]" + ] + ArithSeq{} -> + briDocByExactInlineOnly "ArithSeq" lexpr + PArrSeq{} -> do + -- TODO + briDocByExactInlineOnly "PArrSeq{}" lexpr + HsSCC{} -> do + -- TODO + briDocByExactInlineOnly "HsSCC{}" lexpr + HsCoreAnn{} -> do + -- TODO + briDocByExactInlineOnly "HsCoreAnn{}" lexpr + HsBracket{} -> do + -- TODO + briDocByExactInlineOnly "HsBracket{}" lexpr + HsRnBracketOut{} -> do + -- TODO + briDocByExactInlineOnly "HsRnBracketOut{}" lexpr + HsTcBracketOut{} -> do + -- TODO + briDocByExactInlineOnly "HsTcBracketOut{}" lexpr + HsSpliceE{} -> do + -- TODO + briDocByExactInlineOnly "HsSpliceE{}" lexpr + HsProc{} -> do + -- TODO + briDocByExactInlineOnly "HsProc{}" lexpr + HsStatic{} -> do + -- TODO + briDocByExactInlineOnly "HsStatic{}" lexpr + HsArrApp{} -> do + -- TODO + briDocByExactInlineOnly "HsArrApp{}" lexpr + HsArrForm{} -> do + -- TODO + briDocByExactInlineOnly "HsArrForm{}" lexpr + HsTick{} -> do + -- TODO + briDocByExactInlineOnly "HsTick{}" lexpr + HsBinTick{} -> do + -- TODO + briDocByExactInlineOnly "HsBinTick{}" lexpr + HsTickPragma{} -> do + -- TODO + briDocByExactInlineOnly "HsTickPragma{}" lexpr + EWildPat{} -> do + docLit $ Text.pack "_" + EAsPat asName asExpr -> do + docSeq + [ docLit $ (lrdrNameToText asName) <> Text.pack "@" + , layoutExpr asExpr + ] + EViewPat{} -> do + -- TODO + briDocByExactInlineOnly "EViewPat{}" lexpr + ELazyPat{} -> do + -- TODO + briDocByExactInlineOnly "ELazyPat{}" lexpr + HsWrap{} -> do + -- TODO + briDocByExactInlineOnly "HsWrap{}" lexpr #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ - HsConLikeOut{} -> do - -- TODO - briDocByExactInlineOnly "HsWrap{}" lexpr - ExplicitSum{} -> do - -- TODO - briDocByExactInlineOnly "ExplicitSum{}" lexpr + HsConLikeOut{} -> do + -- TODO + briDocByExactInlineOnly "HsWrap{}" lexpr + ExplicitSum{} -> do + -- TODO + briDocByExactInlineOnly "ExplicitSum{}" lexpr #endif diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index a8d95aa..1187876 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -26,57 +26,58 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName)) -layoutStmt lstmt@(L _ stmt) = docWrapNode lstmt $ case stmt of - LastStmt body False _ -> do - layoutExpr body - BindStmt lPat expr _ _ _ -> do - patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat - expDoc <- docSharedWrapper layoutExpr expr - docAlt - [ docCols - ColBindStmt - [ appSep patDoc - , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc] +layoutStmt lstmt@(L _ stmt) = do + docWrapNode lstmt $ case stmt of + LastStmt body False _ -> do + layoutExpr body + BindStmt lPat expr _ _ _ -> do + patDoc <- fmap return $ colsWrapPat =<< layoutPat lPat + expDoc <- docSharedWrapper layoutExpr expr + docAlt + [ docCols + ColBindStmt + [ appSep patDoc + , docSeq [appSep $ docLit $ Text.pack "<-", docForceParSpacing expDoc] + ] + , docCols + ColBindStmt + [ appSep patDoc + , docAddBaseY BrIndentRegular + $ docPar (docLit $ Text.pack "<-") (expDoc) + ] ] - , docCols - ColBindStmt - [ appSep patDoc - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "<-") (expDoc) + LetStmt binds -> layoutLocalBinds binds >>= \case + Nothing -> docLit $ Text.pack "let" -- i just tested + -- it, and it is + -- indeed allowed. + -- heh. + Just [] -> docLit $ Text.pack "let" -- this probably never happens + Just [bindDoc] -> docAlt + [ docCols + ColDoLet + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ return bindDoc + ] + , docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) ] - ] - LetStmt binds -> layoutLocalBinds binds >>= \case - Nothing -> docLit $ Text.pack "let" -- i just tested - -- it, and it is - -- indeed allowed. - -- heh. - Just [] -> docLit $ Text.pack "let" -- this probably never happens - Just [bindDoc] -> docAlt - [ docCols - ColDoLet - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc + Just bindDocs -> docAlt + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + , docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) ] - , docAddBaseY BrIndentRegular - $ docPar (docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - ] - Just bindDocs -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs + RecStmt stmts _ _ _ _ _ _ _ _ _ -> do + docSeq + [ docLit (Text.pack "rec") + , docSeparator + , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts ] - , docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - ] - RecStmt stmts _ _ _ _ _ _ _ _ _ -> do - docSeq - [ docLit (Text.pack "rec") - , docSeparator - , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts - ] - BodyStmt expr _ _ _ -> do - expDoc <- docSharedWrapper layoutExpr expr - docAddBaseY BrIndentRegular $ expDoc - _ -> briDocByExactInlineOnly "some unknown statement" lstmt + BodyStmt expr _ _ _ -> do + expDoc <- docSharedWrapper layoutExpr expr + docAddBaseY BrIndentRegular $ expDoc + _ -> briDocByExactInlineOnly "some unknown statement" lstmt From 88cbaf813a4b7910c19e83edb3ba22153c12e5c5 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Thu, 21 Sep 2017 23:27:21 +0200 Subject: [PATCH 02/22] Implement `IndentPolicyLeft` for one HsApp case --- .../Brittany/Internal/Layouters/Expr.hs | 57 ++++++++++++------- 1 file changed, 35 insertions(+), 22 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index fe82e3c..cd10792 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -32,6 +32,11 @@ import Language.Haskell.Brittany.Internal.Layouters.Type layoutExpr :: ToBriDoc HsExpr layoutExpr lexpr@(L _ expr) = do + indentPolicy <- mAsk + <&> _conf_layout + .> _lconfig_indentPolicy + .> confUnpack + let allowFreeIndent = indentPolicy == IndentPolicyFree docWrapNode lexpr $ case expr of HsVar vname -> do docLit =<< lrdrNameToTextAnn vname @@ -114,29 +119,35 @@ layoutExpr lexpr@(L _ expr) = do let (headE, paramEs) = gather [exp2] exp1 headDoc <- docSharedWrapper layoutExpr headE paramDocs <- docSharedWrapper layoutExpr `mapM` paramEs - docAlt + docAltFilter [ -- foo x y - docCols ColApp - $ appSep (docForceSingleline headDoc) - : spacifyDocs (docForceSingleline <$> paramDocs) + ( True + , docCols ColApp + $ appSep (docForceSingleline headDoc) + : spacifyDocs (docForceSingleline <$> paramDocs) + ) , -- foo x -- y - docSeq - [ appSep (docForceSingleline headDoc) - , docSetBaseY - $ docAddBaseY BrIndentRegular - $ docLines - $ (docForceSingleline <$> paramDocs) - ] + ( allowFreeIndent + , docSeq + [ appSep (docForceSingleline headDoc) + , docSetBaseY + $ docAddBaseY BrIndentRegular + $ docLines + $ (docForceSingleline <$> paramDocs) + ] + ) , -- foo -- x -- y - docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docForceSingleline headDoc) - ( docNonBottomSpacing - $ docLines paramDocs + ( True + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docForceSingleline headDoc) + ( docNonBottomSpacing + $ docLines paramDocs + ) ) , -- ( multi -- line @@ -144,11 +155,13 @@ layoutExpr lexpr@(L _ expr) = do -- ) -- x -- y - docAddBaseY BrIndentRegular - $ docPar - headDoc - ( docNonBottomSpacing - $ docLines paramDocs + ( True + , docAddBaseY BrIndentRegular + $ docPar + headDoc + ( docNonBottomSpacing + $ docLines paramDocs + ) ) ] HsApp exp1 exp2 -> do From bdf876991334bf79e6768ce58c06dcfab7c03e3a Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Thu, 21 Sep 2017 21:44:10 -0400 Subject: [PATCH 03/22] Remove 3 space special case from HsIf when IndentPolicyLeft ``` if foo bar then baz ``` becomes ``` if foo bar then baz ``` --- .../Haskell/Brittany/Internal/Layouters/Expr.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index cd10792..66169d8 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -415,6 +415,10 @@ layoutExpr lexpr@(L _ expr) = do thenExprDoc <- docSharedWrapper layoutExpr thenExpr elseExprDoc <- docSharedWrapper layoutExpr elseExpr hasComments <- hasAnyCommentsBelow lexpr + let maySpecialIndent = + case indentPolicy of + IndentPolicyLeft -> BrIndentRegular + _ -> BrIndentSpecial 3 docAltFilter [ -- if _ then _ else _ (,) (not hasComments) @@ -443,7 +447,7 @@ layoutExpr lexpr@(L _ expr) = do $ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - ( docAddBaseY (BrIndentSpecial 3) + ( docAddBaseY maySpecialIndent $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc @@ -483,7 +487,7 @@ layoutExpr lexpr@(L _ expr) = do (,) True $ docAddBaseY BrIndentRegular $ docPar - ( docAddBaseY (BrIndentSpecial 3) + ( docAddBaseY maySpecialIndent $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc @@ -506,7 +510,7 @@ layoutExpr lexpr@(L _ expr) = do , (,) True $ docSetBaseY $ docLines - [ docAddBaseY (BrIndentSpecial 3) + [ docAddBaseY maySpecialIndent $ docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ ifExprDoc From ce41178df5b6dbec12b68d7eec3d743cccbda15e Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Thu, 21 Sep 2017 21:47:30 -0400 Subject: [PATCH 04/22] Remove context sensitive let indentation when IndentPolicyLeft Let expressions with multiple bindings automattically indent and pull left ``` let a = b c = d in foo bar baz ``` ``` let a = b c = d in foo bar baz ``` ``` let a = b c = d in foo bar baz ``` ``` let a = b c = d in foo bar baz ``` --- .../Brittany/Internal/Layouters/Expr.hs | 77 ++++++++++++++----- 1 file changed, 57 insertions(+), 20 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 66169d8..a56144e 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -567,28 +567,65 @@ layoutExpr lexpr@(L _ expr) = do (docSetBaseY $ expDoc1) ] ] - Just bindDocs@(_:_) -> docAlt - [ docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs + Just bindDocs@(_:_) -> docAlt $ + case indentPolicy of + IndentPolicyLeft -> + --either + -- let + -- a = b + -- c = d + -- in foo + -- bar + -- baz + --or + -- let + -- a = b + -- c = d + -- in + -- fooooooooooooooooooo + [ docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docSeq + [ docLit $ Text.pack "in " + , docAddBaseY BrIndentRegular $ expDoc1 + ] + ] + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 + _ -> + [ docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) - ] - ] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1] HsDo DoExpr (L _ stmts) _ -> do From 3bbf81baabb05b1d1206f76851bc46529da73060 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:05:58 -0500 Subject: [PATCH 05/22] Add literate tests for context free formatting Left indent combined with no columnized alignment represents a context free formatting style for brittany. These tests allow this format to be tested until inline formatting tools are available to make these files less redundant. --- src-literatetests/Main.hs | 40 +- src-literatetests/tests-context-free.blt | 1109 ++++++++++++++++++++++ 2 files changed, 1140 insertions(+), 9 deletions(-) create mode 100644 src-literatetests/tests-context-free.blt diff --git a/src-literatetests/Main.hs b/src-literatetests/Main.hs index 34b4e4e..938aca6 100644 --- a/src-literatetests/Main.hs +++ b/src-literatetests/Main.hs @@ -40,14 +40,27 @@ data InputLine main :: IO () main = do files <- System.Directory.listDirectory "src-literatetests/" - let blts = List.sort $ filter (".blt" `isSuffixOf`) files + let blts = + List.sort + $ filter (\x -> not ("tests-context-free.blt" `isSuffixOf` x)) + $ filter (".blt"`isSuffixOf`) files inputs <- blts `forM` \blt -> Text.IO.readFile ("src-literatetests" blt) let groups = createChunks =<< inputs - hspec $ groups `forM_` \(groupname, tests) -> do - describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do - (if pend then before_ pending else id) - $ it (Text.unpack name) - $ roundTripEqual inp + inputCtxFree <- Text.IO.readFile "src-literatetests/tests-context-free.blt" + let groupsCtxFree = createChunks inputCtxFree + hspec $ do + groups `forM_` \(groupname, tests) -> do + describe (Text.unpack groupname) $ tests `forM_` \(name, pend, inp) -> do + (if pend then before_ pending else id) + $ it (Text.unpack name) + $ roundTripEqual defaultTestConfig inp + groupsCtxFree `forM_` \(groupname, tests) -> do + describe ("context free: " ++ Text.unpack groupname) + $ tests + `forM_` \(name, pend, inp) -> do + (if pend then before_ pending else id) + $ it (Text.unpack name) + $ roundTripEqual contextFreeTestConfig inp where -- this function might be implemented in a weirdly complex fashion; the -- reason being that it was copied from a somewhat more complex variant. @@ -132,10 +145,10 @@ main = do -------------------- -- past this line: copy-pasta from other test (meh..) -------------------- -roundTripEqual :: Text -> Expectation -roundTripEqual t = +roundTripEqual :: Config -> Text -> Expectation +roundTripEqual c t = fmap (fmap PPTextWrapper) - (parsePrintModuleTests defaultTestConfig "TestFakeFileName.hs" t) + (parsePrintModuleTests c "TestFakeFileName.hs" t) `shouldReturn` Right (PPTextWrapper t) newtype PPTextWrapper = PPTextWrapper Text @@ -170,3 +183,12 @@ defaultTestConfig = Config } } +contextFreeTestConfig :: Config +contextFreeTestConfig = + defaultTestConfig + { _conf_layout = (_conf_layout defaultTestConfig) + {_lconfig_indentPolicy = coerce IndentPolicyLeft + ,_lconfig_alignmentLimit = coerce (1 :: Int) + ,_lconfig_columnAlignMode = coerce ColumnAlignModeDisabled + } + } diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt new file mode 100644 index 0000000..e126dde --- /dev/null +++ b/src-literatetests/tests-context-free.blt @@ -0,0 +1,1109 @@ + +############################################################################### +############################################################################### +############################################################################### +#group type signatures +############################################################################### +############################################################################### +############################################################################### + +#test simple001 +func :: a -> a + +#test long typeVar +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test keep linebreak mode +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lakjsdlkjasldkj + -> lakjsdlkjasldkj + +#test simple parens 1 +func :: ((a)) + +#test simple parens 2 +func :: (a -> a) -> a + +#test simple parens 3 +func :: a -> (a -> a) + +#test did anyone say parentheses? +func :: (((((((((()))))))))) + +-- current output is.. funny. wonder if that can/needs to be improved.. +#test give me more! +#pending +func :: ((((((((((((((((((((((((((((((((((((((((((())))))))))))))))))))))))))))))))))))))))))) + +#test unit +func :: () + + +############################################################################### + +#test paren'd func 1 +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lakjsdlkjasldkj + -> lakjsdlkjasldkj + ) + +#test paren'd func 2 +func + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> (lakjsdlkjasldkj -> lakjsdlkjasldkj) + +#test paren'd func 3 +func + :: (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> lakjsdlkjasldkj) + -> lakjsdlkjasldkj + +#test paren'd func 4 +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + -> lakjsdlkjasldkj + +#test paren'd func 5 +func + :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ) + +############################################################################### + +#test type application 1 +func :: asd -> Either a b + +#test type application 2 +func + :: asd + -> Either + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application 3 +func + :: asd + -> Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application 4 +func + :: Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> asd + +#test type application 5 +func + :: Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -> asd) + +#test type application 6 +func + :: Trither + asd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test type application paren 1 +func + :: asd + -> ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test type application paren 2 +func + :: asd + -> ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +#test type application paren 3 +func + :: ( Trither + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> asd + +############################################################################### + +#test list simple +func :: [a -> b] + +#test list func +func + :: [ lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ] + +#test list paren +func + :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ] + +################################################################## -- ############# + +#test tuple type 1 +func :: (a, b, c) + +#test tuple type 2 +func :: ((a, b, c), (a, b, c), (a, b, c)) + +#test tuple type long +func + :: ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + +#test tuple type nested +func + :: ( ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , (lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd) + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ) + +#test tuple type function +func + :: [ ( lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + ] +############################################################################### +#test type operator stuff +#pending +test050 :: a :+: b +test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + +############################################################################### + +#test forall oneliner +{-# LANGUAGE ScopedTypeVariables #-} +func :: forall (a :: *) b . a -> b + +#test forall context multiline +{-# LANGUAGE ScopedTypeVariables #-} +func + :: forall m + . Foo + => ColMap2 + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> m () + +#test forall no-context multiline +{-# LANGUAGE ScopedTypeVariables #-} +func + :: forall m + . ColMap2 + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> ColInfo + -> m () + +#test language pragma issue +{-# LANGUAGE ScopedTypeVariables #-} +func :: forall (a :: *) b . a -> b + +#test comments 1 +func :: a -> b -- comment + +#test comments 2 +funcA :: a -> b -- comment A +funcB :: a -> b -- comment B + +#test comments all +#pending +-- a +func -- b + :: -- c + a -- d + -> -- e + ( -- f + c -- g + , -- h + d -- i + ) -- j +-- k + +############################################################################### + +#test ImplicitParams 1 +{-# LANGUAGE ImplicitParams #-} +func :: (?asd::Int) -> () + +#test ImplicitParams 2 +{-# LANGUAGE ImplicitParams #-} +func + :: ( ?asd + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + ) + -> () + + +############################################################################### +############################################################################### +############################################################################### +#group type signatures pragmas +############################################################################### +############################################################################### +############################################################################### + +#test inline pragma 1 +func = f + where + {-# INLINE f #-} + f = id + +#test inline pragma 2 +func = ($) + where + {-# INLINE ($) #-} + ($) = id + +#test inline pragma 3 +func = f + where + {-# INLINE CONLIKE [1] f #-} + f = id + +#test inline pragma 4 +#pending this does not work with the compiler version we currently use yet (i think). should work with ghc-8.0.2. +func = f + where + {-# INLINE [~] f #-} + f = id + + +############################################################################### +############################################################################### +############################################################################### +#group equation.basic +############################################################################### +############################################################################### +############################################################################### +## some basic testing of different kinds of equations. +## some focus on column layouting for multiple-equation definitions. +## (that part probably is not implemented in any way yet.) + +#test basic 1 +func x = x + +#test infix 1 +x *** y = x + +#test symbol prefix +(***) x y = x + + +############################################################################### +############################################################################### +############################################################################### +#group equation.patterns +############################################################################### +############################################################################### +############################################################################### + +#test wildcard +func _ = x + +#test simple long pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + = x + +#test simple multiline pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + = x + +#test another multiline pattern +#pending +func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + a + b + = x + +#test simple constructor +func (A a) = a + +#test list constructor +func (x:xr) = x + +#test some other constructor symbol +#pending +func (x:+:xr) = x + + +############################################################################### +############################################################################### +############################################################################### +#group equation.guards +############################################################################### +############################################################################### +############################################################################### +#test simple guard +func | True = x + +#test multiple-clauses-1 +func x | x = simple expression + | otherwise = 0 + +#test multiple-clauses-2 +func x + | a somewhat longer guard x = "and a somewhat longer expession that does not" + | otherwise = "fit without putting the guards in new lines" + +#test multiple-clauses-3 +func x + | very long guard, another rather long guard that refers to x = nontrivial + expression + foo + bar + alsdkjlasdjlasj + | otherwise = 0 + +#test multiple-clauses-4 +func x + | very long guard, another rather long guard that refers to x + = nontrivialexpression foo bar alsdkjlasdjlasj + | otherwise + = 0 + +#test multiple-clauses-5 +func x + | very loooooooooooooooooooooooooooooong guard + , another rather long guard that refers to x + = nontrivial expression foo bar alsdkjlasdjlasj + | otherwise + = 0 + + +############################################################################### +############################################################################### +############################################################################### +#group expression.basic +############################################################################### +############################################################################### +############################################################################### + +#test var +func = x + +describe "infix op" $ do +#test 1 +func = x + x + +#test long +#pending +func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test long keep linemode 1 +#pending +func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + +#test long keep linemode 2 +#pending +func = mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + +#test literals +func = 1 +func = "abc" +func = 1.1e5 +func = 'x' +func = 981409823458910394810928414192837123987123987123 + +#test lambdacase +{-# LANGUAGE LambdaCase #-} +func = \case + FooBar -> x + Baz -> y + +#test lambda +func = \x -> abc + +describe "app" $ do +#test 1 +func = klajsdas klajsdas klajsdas + +#test 2 +func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + +#test 3 +func = lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + lakjsdlajsdljas + lakjsdlajsdljas + lakjsdlajsdljas + +### +#group expression.basic.sections +### + +#test left +func = (1+) + +#test right +func = (+1) + +#test left inf +## TODO: this could be improved.. +func = (1`abc`) + +#test right inf +func = (`abc`1) + +### +#group tuples +### + +#test 1 +func = (abc, def) + +#test 2 +#pending +func = (lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd + , lakjsdlajsdljasdlkjasldjasldjasldjalsdjlaskjd) + + + +############################################################################### +############################################################################### +############################################################################### +#group expression.do statements +############################################################################### +############################################################################### +############################################################################### + +#test simple +func = do + stmt + stmt + +#test bind +func = do + x <- stmt + stmt x + +#test let +func = do + let x = 13 + stmt x + + +############################################################################### +############################################################################### +############################################################################### +#group expression.lists +############################################################################### +############################################################################### +############################################################################### + +#test monad-comprehension-case-of +func = + foooooo + $ [ case + foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + of + _ -> True + ] + + +############################################################################### +############################################################################### +############################################################################### +#group expression.multiwayif +############################################################################### +############################################################################### +############################################################################### + +#test simple +{-# LANGUAGE MultiWayIf #-} +func = if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + +#test simplenested +{-# LANGUAGE MultiWayIf #-} +func = do + foo + bar $ if + | cond1 -> loooooooooooooooooooooooooooooong expr1 + | cond2 -> loooooooooooooooooooooooooooooong expr2 + + +############################################################################### +############################################################################### +############################################################################### +#group stylisticspecialcases +############################################################################### +############################################################################### +############################################################################### + +#test operatorprefixalignment-even-with-multiline-alignbreak +func = + foo + $ [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb + ] + ++ [ccccccccccccccccccccccccccccccccccccccccccccccccccccccccc] + + +############################################################################### +############################################################################### +############################################################################### +#group regression +############################################################################### +############################################################################### +############################################################################### + +#test newlines-comment +func = do + abc <- foo + +--abc +return () + +#test parenthesis-around-unit +func = (()) + +#test let-defs indentation +func = do + let + foo True = True + foo _ = False + return () + +#test let-defs no indent +func = do + let + foo True = True + foo _ = False + return () + +#test let-defs no indent +func = do + let + foo = True + b = False + return () + +#test let-defs no indent +func = + let + foo = True + b = False + in return () + +#test record update indentation 1 +func = do + s <- mGet + mSet $ s { _lstate_indent = _lstate_indent state } + +#test record update indentation 2 +func = do + s <- mGet + mSet $ s { _lstate_indent = _lstate_indent state + , _lstate_indent = _lstate_indent state + } + +#test record update indentation 3 +func = do + s <- mGet + mSet $ s + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test post-indent comment +func = do +-- abc + -- def + return () + +#test post-unindent comment +func = do + do + return () + -- abc + -- def + return () + +#test CPP empty comment case +#pending CPP parsing needs fixing for roundTripEqual +{-# LANGUAGE CPP #-} +module Test where +func = do +#if FOO + let x = 13 +#endif + stmt x + +## really, the following should be handled by forcing the Alt to multiline +## because there are comments. as long as this is not implemented though, +## we should ensure the trivial solution works. +#test comment inline placement (temporary) +func + :: Int -- basic indentation amount + -> Int -- currently used width in current line (after indent) + -- used to accurately calc placing of the current-line + -> LayoutDesc + -> Int + +#test some indentation thingy +func = + ( lkjadljasldjalskdjaldjalsdjkalsdjlaksdjlasjdlajsaldskj + $ abc + $ def + $ ghi + $ jkl + ) + +#test parenthesized operator +buildG bounds0 edges0 = accumArray (flip (:)) [] bounds0 (map reassoc edges0) + where reassoc (v, e, w) = (v, (e, w)) + +#test record pattern matching stuff +downloadRepoPackage = case repo of + RepoLocal {..} -> return () + RepoLocal { abc } -> return () + RepoLocal{} -> return () + +#test do let comment indentation level problem +func = do + let + (primaryPkg, otherPkgs) = selectPrimaryLocalPackage pwd pkgs' + (bproblems, x) = resolveBuildTargets primaryPkg otherPkgs utargets'' + -- default local dir target if there's no given target + utargets'' = "foo" + return () + +#test list comprehension comment placement +func = + [ (thing, take 10 alts) --TODO: select best ones + | (thing, _got, alts@(_:_)) <- nosuchFooThing + , gast <- award + ] + +#test if-then-else comment placement +func = if x + then if y -- y is important + then foo + else bar + else Nothing + +#test qualified infix pattern +#pending "TODO" +wrapPatPrepend pat prepElem = do + patDocs <- layoutPat pat + case Seq.viewl patDocs of + Seq.EmptyL -> return $ Seq.empty + x1 Seq.:< xR -> do + x1' <- docSeq [prepElem, return x1] + return $ x1' Seq.<| xR + +#test type signature multiline forcing issue +layoutWriteNewlineBlock + :: ( MonadMultiWriter Text.Builder.Builder m + , MonadMultiState LayoutState m + , MonadMultiWriter (Seq String) m + ) + => m () + +#test multiwayif proper indentation +{-# LANGUAGE MultiWayIf #-} +readMergePersConfig path shouldCreate conf = do + exists <- liftIO $ System.Directory.doesFileExist path + if + | exists -> do + contents <- liftIO $ ByteString.readFile path -- no lazy IO, tyvm. + fileConf <- case Data.Yaml.decodeEither contents of + Left e -> do + liftIO + $ putStrErrLn + $ "error reading in brittany config from " + ++ path + ++ ":" + liftIO $ putStrErrLn e + mzero + Right x -> return x + return $ fileConf Semigroup.<> conf + | shouldCreate -> do + liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap + (Option . Just . runIdentity) + staticDefaultConfig + return $ conf + | otherwise -> do + return conf + +#test nested pattern alignment issue" +func = BuildReport + where + convertInstallOutcome = case result of + Left BR.PlanningFailed -> PlanningFailed + Left (BR.DependentFailed p) -> DependencyFailed p + Left (BR.DownloadFailed _) -> DownloadFailed + Left (BR.UnpackFailed _) -> UnpackFailed + Left (BR.ConfigureFailed _) -> ConfigureFailed + Left (BR.BuildFailed _) -> BuildFailed + Left (BR.TestsFailed _) -> TestsFailed + Left (BR.InstallFailed _) -> InstallFailed + Right (BR.BuildOk _ _ _) -> InstallOk + +#test nested pattern alignment issue" +func = BuildReport + where + convertInstallOutcome = case result of + Left BR.PlanningFailed -> PlanningFailed + Left (BR.DependentFailed p) -> DependencyFailed p + Left (BR.DownloadFailed _) -> DownloadFailed + Left (BR.UnpackFailed _) -> UnpackFailed + Left (BR.ConfigureFailed _) -> ConfigureFailed + Left (BR.BuildFailed _) -> BuildFailed + Left (BR.TestsFailed _) -> TestsFailed + Left (BR.InstallFailed _) -> InstallFailed + Right (BR.BuildOk _ _ _) -> InstallOk + +#test partially overflowing alignment issue" +showPackageDetailedInfo pkginfo = + renderStyle (style { lineLength = 80, ribbonsPerLine = 1 }) + $ char '*' + $+$ something + [ entry "Synopsis" synopsis hideIfNull reflowParagraphs + , entry + "Versions available" + sourceVersions + (altText null "[ Not available from server ]") + (dispTopVersions 9 (preferredVersions pkginfo)) + , entry + "Versions installed" + installedVersions + ( altText + null + (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]") + ) + (dispTopVersions 4 (preferredVersions pkginfo)) + , entry "Homepage" homepage orNotSpecified text + , entry "Bug reports" bugReports orNotSpecified text + , entry "Description" description hideIfNull reflowParagraphs + , entry "Category" category hideIfNull text + , entry "License" license alwaysShow disp + , entry "Author" author hideIfNull reflowLines + , entry "Maintainer" maintainer hideIfNull reflowLines + , entry "Source repo" sourceRepo orNotSpecified text + , entry "Executables" executables hideIfNull (commaSep text) + , entry "Flags" flags hideIfNull (commaSep dispFlag) + , entry "Dependencies" dependencies hideIfNull (commaSep dispExtDep) + , entry "Documentation" haddockHtml showIfInstalled text + , entry "Cached" haveTarball alwaysShow dispYesNo + , if not (hasLib pkginfo) + then empty + else text "Modules:" + $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo)) + ] + +#test issue 7a +isValidPosition position | validX && validY = Just position + | otherwise = Nothing + +#test issue-6-pattern-linebreak-validity +## this is ugly, but at least syntactically valid. +foo = Reflex.runSpiderHost $ ReflexHost.hostApp $ do + (inputEvent :: Reflex.Event Reflex.Spider String, inputFire :: String + -> IO Bool) <- + ReflexHost.newExternalEvent + liftIO . forkIO . forever $ getLine >>= inputFire + ReflexHost.performEvent_ $ fmap (liftIO . putStrLn) inputEvent + +#test issue 16 +foldrDesc f z = unSwitchQueue $ \q -> + switch (Min.foldrDesc (f unTaggedF) z q) (Min.foldrAsc (f unTaggedF) z q) + +#test issue 18 +autocheckCases = + [ ("Never Deadlocks", representative deadlocksNever) + , ("No Exceptions", representative exceptionsNever) + , ("Consistent Result", alwaysSame) -- already representative + ] + +#test issue 18b +autocheckCases = + [ ("Never Deadlocks", representative deadlocksNever) + , ("No Exceptions", representative exceptionsNever) + , ( "Consistent Result" + , alwaysSame -- already representative + ) + ] + +#test issue 18c +func = + [ (abc, (1111, 1111)) + , (def, (2, 2)) + , foo -- comment + ] + +#test issue 26 +foo a b = g a b -- fooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo + where g a b = b + b * a + +#test issue 26b +foo a b = g a b where g a b = b + b * a -- fooooooooooooooooooooooooooooooooooo + +#test aggressive alignment 1 +func = do + abc <- expr + abcccccccccccccccccc <- expr + abcccccccccccccccccccccccccccccccccccccccccc <- expr + abccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc <- expr + +#test example alignment 1 +func (MyLongFoo abc def) = 1 +func (Bar a d) = 2 +func _ = 3 + +#test listcomprehension-case-of +parserCompactLocation = + [ try + $ [ ParseRelAbs (Text.Read.read digits) _ _ + | digits <- many1 digit + , rel1 :: Maybe (Either Int (Ratio Int)) <- optionMaybe + [ case divPart of + Nothing -> Left $ Text.Read.read digits + Just ddigits -> + Right $ Text.Read.read digits % Text.Read.read ddigits + | digits <- many1 digit + , divPart <- optionMaybe (string "/" *> many1 digit) + ] + ] + ] + +#test opapp-specialcasing-1 +func = fooooooooooooooooooooooooooooooooo $ foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + +#test opapp-specialcasing-2 +func = + fooooooooooooooooooooooooooooooooo + + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + +#test opapp-specialcasing-3 +func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo + [ foooooooooooooooooooooooooooooooo + , foooooooooooooooooooooooooooooooo + , foooooooooooooooooooooooooooooooo + ] + +#test opapp-indenting +parserPrim = + [ r + | r <- + [ SGPPrimFloat $ bool id (0-) minus $ readGnok + "parserPrim" + (d1 ++ d2 ++ d3 ++ d4) + | d2 <- string "." + , d3 <- many1 (oneOf "0123456789") + , _ <- string "f" + ] + <|> [ SGPPrimFloat $ bool id (0-) minus $ fromIntegral + (readGnok "parserPrim" d1 :: Integer) + | _ <- string "f" + ] + <|> [ SGPPrimInt $ bool id (0-) minus $ fromIntegral + (readGnok "parserPrim" d1 :: Integer) + | _ <- string "i" + ] + ] + +#test another-parspacing-testcase + +samples = (SV.unpackaaaaadat) <&> \f -> + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + +#test recordupd-singleline-bug + +runBrittany tabSize text = do + let + config' = staticDefaultConfig + config = config' + { _conf_layout = (_conf_layout config') { _lconfig_indentAmount = coerce + tabSize + } + , _conf_forward = forwardOptionsSyntaxExtsEnabled + } + parsePrintModule config text + +#test issue 38 + +{-# LANGUAGE TypeApplications #-} +foo = bar @Baz + +#test comment-before-BDCols +{-# LANGUAGE TypeApplications #-} +layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do + docAlt + $ -- one-line solution + [ docCols + (ColBindingLine alignmentToken) + [ docSeq (patPartInline ++ [guardPart]) + , docSeq + [ appSep $ return binderDoc + , docForceSingleline $ return body + , wherePart + ] + ] + | not hasComments + , [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + , wherePart <- case mWhereDocs of + Nothing -> return @[] $ docEmpty + Just [w] -> return @[] $ docSeq + [ docSeparator + , appSep $ docLit $ Text.pack "where" + , docSetIndentLevel $ docForceSingleline $ return w + ] + _ -> [] + ] + ++ -- one-line solution + where in next line(s) + [ docLines + $ [ docCols + (ColBindingLine alignmentToken) + [ docSeq (patPartInline ++ [guardPart]) + , docSeq + [appSep $ return binderDoc, docForceParSpacing $ return body] + ] + ] + ++ wherePartMultiLine + | [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + , Data.Maybe.isJust mWhereDocs + ] + ++ -- two-line solution + where in next line(s) + [ docLines + $ [ docForceSingleline + $ docSeq (patPartInline ++ [guardPart, return binderDoc]) + , docEnsureIndent BrIndentRegular $ docForceSingleline $ return + body + ] + ++ wherePartMultiLine + | [(guards, body, _bodyRaw)] <- [clauseDocs] + , let guardPart = singleLineGuardsDoc guards + ] + +#test comment-testcase-17 +{-# LANGUAGE MultiWayIf #-} +func = do + let foo = if + | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO + -> max + (defLen - 0.2) -- TODO + (defLen * 0.8) + | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO + return True + +#test issue 49 + +foo n = case n of + 1 -> True + -1 -> False + +bar n = case n of + (-2, -2) -> (-2, -2) + +#test issue 48 a + +foo = + let + a = b@1 + cccc = () + in foo + +#test issue 48 b + +{-# LANGUAGE TypeApplications #-} +foo = + let + a = b @1 + cccc = () + in foo + + +############################################################################### +############################################################################### +############################################################################### +#group pending +############################################################################### +############################################################################### +############################################################################### + + + +## this testcase is not about idempotency, but about _how_ the output differs +## from the input; i cannot really express this yet with the current +## test-suite. +## #test ayaz +## +## myManageHook = +## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience] +## <+> composeAll +## [ className =? "Pidgin" --> doFloat +## , className =? "XCalc" --> doFloat +## -- plan9port's acme +## , className =? "acme" --> doFloat +## -- Acme with Vi bindings editor +## , title =? "ED" --> doFloat +## , title =? "wlc-x11" --> doFloat +## , className =? "Skype" --> doFloat +## , className =? "ffplay" --> doFloat +## , className =? "mpv" --> doFloat +## , className =? "Plugin-container" --> doFloat -- Firefox flash, etc. +## -- Firefox works well tiled, but it has dialog windows we want to float. +## , appName =? "Browser" --> doFloat +## ] +## where +## role = stringProperty "WM_WINDOW_ROLE" + From de5f0401f3ffaab397370cd60227d7086fc7a703 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:08:11 -0500 Subject: [PATCH 06/22] Add consistency between contsrained and unconstrained forall format Constrained forall formats aligned the `.` to the left. Constrained formats aligned the `.` to the right. This change adds consistency between both formats. --- .../Haskell/Brittany/Internal/Layouters/Type.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs index a5148f5..bd4d728 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Type.hs @@ -174,17 +174,17 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of , docForceSingleline $ return $ typeDoc ] -- :: forall x - -- . x + -- . x , docPar (docSeq $ docLit (Text.pack "forall") : tyVarDocLineList) ( docCols ColTyOpPrefix - [ docWrapNodeRest ltype $ docLit $ Text.pack ". " + [ docWrapNodeRest ltype $ docLit $ Text.pack " . " , maybeForceML $ return typeDoc ] ) -- :: forall -- (x :: *) - -- . x + -- . x , docPar (docLit (Text.pack "forall")) (docLines @@ -204,7 +204,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ] ) ++[ docCols ColTyOpPrefix - [ docWrapNodeRest ltype $ docLit $ Text.pack ". " + [ docWrapNodeRest ltype $ docLit $ Text.pack " . " , maybeForceML $ return typeDoc ] ] @@ -499,7 +499,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of ) (docCols ColTyOpPrefix [ docWrapNodeRest ltype - $ docLit $ Text.pack "::" + $ docLit $ Text.pack ":: " , docAddBaseY (BrIndentSpecial 2) typeDoc1 ]) ] From a13a137f681ccb5ee2d202faaee2cc2282163076 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:09:29 -0500 Subject: [PATCH 07/22] Add left indent support for statements This aligns left indent style `let` statements with their expression form. --- .../Brittany/Internal/Layouters/Stmt.hs | 22 +++++++++++-------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 1187876..6f95585 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -11,6 +11,7 @@ where import Language.Haskell.Brittany.Internal.Types import Language.Haskell.Brittany.Internal.LayouterBasics +import Language.Haskell.Brittany.Internal.Config.Types import RdrName ( RdrName(..) ) import GHC ( runGhc, GenLocated(L), moduleNameString ) @@ -27,6 +28,7 @@ import {-# SOURCE #-} Language.Haskell.Brittany.Internal.Layouters.Expr layoutStmt :: ToBriDoc' (StmtLR RdrName RdrName (LHsExpr RdrName)) layoutStmt lstmt@(L _ stmt) = do + indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack docWrapNode lstmt $ case stmt of LastStmt body False _ -> do layoutExpr body @@ -62,15 +64,17 @@ layoutStmt lstmt@(L _ stmt) = do (docLit $ Text.pack "let") (docSetBaseAndIndent $ return bindDoc) ] - Just bindDocs -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - , docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - ] + Just bindDocs -> + let letSeq = docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + letRegular = docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + in case indentPolicy of + IndentPolicyLeft -> docAlt [letRegular] + _ -> docAlt [letSeq, letRegular] RecStmt stmts _ _ _ _ _ _ _ _ _ -> do docSeq [ docLit (Text.pack "rec") From cd9f7de56645f8b0fcc8b2ded71a66fe5b6cbdb6 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:18:41 -0500 Subject: [PATCH 08/22] Update pending type operator test for context free. --- src-literatetests/tests-context-free.blt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index e126dde..9529bee 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -198,12 +198,12 @@ func #test type operator stuff #pending test050 :: a :+: b -test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd ############################################################################### From f3c37a6abf3ebeb6c92c31622294788d9f34bc9b Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:20:41 -0500 Subject: [PATCH 09/22] Update pending long argument test to context free. --- src-literatetests/tests-context-free.blt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 9529bee..11e1bee 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -350,14 +350,14 @@ func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable #test simple multiline pattern #pending func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable + reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable = x #test another multiline pattern #pending func reallyreallyreallyreallyreallyreallyreallyreallyreallyreallylongvariable - a - b + a + b = x #test simple constructor From d1e19842066d859504e7d9d348936d98ef8c1d23 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:50:54 -0500 Subject: [PATCH 10/22] Update guard formatting for IndentPolicyLeft --- src-literatetests/tests-context-free.blt | 10 ++-- .../Brittany/Internal/Layouters/Decl.hs | 47 ++++++++++++++----- 2 files changed, 42 insertions(+), 15 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 11e1bee..be8a8c9 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -382,8 +382,9 @@ func (x:+:xr) = x func | True = x #test multiple-clauses-1 -func x | x = simple expression - | otherwise = 0 +func x + | x = simple expression + | otherwise = 0 #test multiple-clauses-2 func x @@ -845,8 +846,9 @@ showPackageDetailedInfo pkginfo = ] #test issue 7a -isValidPosition position | validX && validY = Just position - | otherwise = Nothing +isValidPosition position + | validX && validY = Just position + | otherwise = Nothing #test issue-6-pattern-linebreak-validity ## this is ugly, but at least syntactically valid. diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 5073eab..30e26c2 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -265,9 +265,15 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha gs -> docSeq $ [appSep $ docLit $ Text.pack "|"] ++ List.intersperse docCommaSep (return <$> gs) - docAlt + + indentPolicy <- mAsk + <&> _conf_layout + .> _lconfig_indentPolicy + .> confUnpack + docAltFilter $ -- one-line solution - [ docCols + [ ( True + , docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) , docSeq @@ -276,6 +282,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha , wherePart ] ] + ) | not hasComments , [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards @@ -289,7 +296,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha _ -> [] ] ++ -- one-line solution + where in next line(s) - [ docLines + [ ( True + , docLines $ [ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) @@ -298,23 +306,27 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards , Data.Maybe.isJust mWhereDocs ] ++ -- two-line solution + where in next line(s) - [ docLines + [ ( True + , docLines $ [ docForceSingleline $ docSeq (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- pattern and exactly one clause in single line, body as par; -- where in following lines - [ docLines + [ ( True + , docLines $ [ docCols (ColBindingLine alignmentToken) [ docSeq (patPartInline ++ [guardPart]) @@ -329,24 +341,28 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha -- , docAddBaseY BrIndentRegular $ return body -- ] ++ wherePartMultiLine + ) | [(guards, body, _bodyRaw)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- pattern and exactly one clause in single line, body in new line. - [ docLines + [ ( True + , docLines $ [ docSeq (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docNonBottomSpacing $ (docAddBaseY BrIndentRegular $ return body) ] ++ wherePartMultiLine + ) | [(guards, body, _)] <- [clauseDocs] , let guardPart = singleLineGuardsDoc guards ] ++ -- multiple clauses added in-paragraph, each in a single line -- example: foo | bar = baz -- | lll = asd - [ docLines + [ ( indentPolicy /= IndentPolicyLeft + , docLines $ [ docSeq [ appSep $ docForceSingleline $ return patDoc , docSetBaseY @@ -370,10 +386,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) | Just patDoc <- [mPatDoc] ] ++ -- multiple clauses, each in a separate, single line - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -396,10 +414,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- multiple clauses, each with the guard(s) in a single line, body -- as a paragraph - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -431,10 +451,12 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- multiple clauses, each with the guard(s) in a single line, body -- in a new line as a paragraph - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -464,9 +486,11 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] ++ -- conservative approach: everything starts on the left. - [ docLines + [ ( True + , docLines $ [ docAddBaseY BrIndentRegular $ patPartParWrap $ docLines @@ -494,4 +518,5 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha ] ] ++ wherePartMultiLine + ) ] From a6bea7542b098a319b488a2b596af4df8ac9ac51 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 15:53:31 -0500 Subject: [PATCH 11/22] Update pending long operator use for left indent. --- src-literatetests/tests-context-free.blt | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index be8a8c9..71c6809 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -434,19 +434,19 @@ func = x + x #test long #pending func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test long keep linemode 1 #pending func = mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksj #test long keep linemode 2 #pending func = mweroiuxlskdfjlksj - + mweroiuxlskdfjlksj - + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj + + mweroiuxlskdfjlksj + + mweroiuxlskdfjlksjdflkjsdfljksldkjflkjsdflkj #test literals func = 1 From 44e95940c0ff98b82f533f6b1c1fbb06899f4113 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 16:03:29 -0500 Subject: [PATCH 12/22] Change record update syntax for left indent policy --- src-literatetests/tests-context-free.blt | 13 +- .../Brittany/Internal/Layouters/Expr.hs | 150 +++++++++--------- 2 files changed, 85 insertions(+), 78 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 71c6809..58b6406 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -646,9 +646,10 @@ func = do #test record update indentation 2 func = do s <- mGet - mSet $ s { _lstate_indent = _lstate_indent state - , _lstate_indent = _lstate_indent state - } + mSet $ s + { _lstate_indent = _lstate_indent state + , _lstate_indent = _lstate_indent state + } #test record update indentation 3 func = do @@ -972,9 +973,9 @@ 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 diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index a56144e..86e86ac 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -853,81 +853,87 @@ layoutExpr lexpr@(L _ expr) = do return $ case ambName of Unambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) Ambiguous n _ -> (lfield, lrdrNameToText n, rFExpDoc) - docAlt + docAltFilter -- singleline - [ docSeq - [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc - , appSep $ docLit $ Text.pack "{" - , appSep $ docSeq $ List.intersperse docCommaSep - $ rFs <&> \case - (lfield, fieldStr, Just fieldDoc) -> - docWrapNode lfield $ docSeq - [ appSep $ docLit fieldStr - , appSep $ docLit $ Text.pack "=" - , docForceSingleline fieldDoc - ] - (lfield, fieldStr, Nothing) -> - docWrapNode lfield $ docLit fieldStr - , docLit $ Text.pack "}" - ] + [ ( True + , docSeq + [ docNodeAnnKW lexpr Nothing $ appSep $ docForceSingleline rExprDoc + , appSep $ docLit $ Text.pack "{" + , appSep $ docSeq $ List.intersperse docCommaSep + $ rFs <&> \case + (lfield, fieldStr, Just fieldDoc) -> + docWrapNode lfield $ docSeq + [ appSep $ docLit fieldStr + , appSep $ docLit $ Text.pack "=" + , docForceSingleline fieldDoc + ] + (lfield, fieldStr, Nothing) -> + docWrapNode lfield $ docLit fieldStr + , docLit $ Text.pack "}" + ] + ) -- wild-indentation block - , docSeq - [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc - , docSetBaseY $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , case rF1e of - Just x -> docWrapNodeRest rF1f $ docSeq - [ appSep $ docLit $ Text.pack "=" - , docForceSingleline $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docForceSingleline x + , ( indentPolicy /= IndentPolicyLeft + , docSeq + [ docNodeAnnKW lexpr Nothing $ appSep rExprDoc + , docSetBaseY $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , case rF1e of + Just x -> docWrapNodeRest rF1f $ docSeq + [ appSep $ docLit $ Text.pack "=" + , docForceSingleline $ x ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN] - ] + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docForceSingleline x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN] + ] + ) -- strict indentation block - , docSetParSpacing - $ docAddBaseY BrIndentRegular - $ docPar - (docNodeAnnKW lexpr Nothing $ rExprDoc) - (docNonBottomSpacing $ docLines $ let - line1 = docCols ColRecUpdate - [ appSep $ docLit $ Text.pack "{" - , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n - , docWrapNodeRest rF1f $ case rF1e of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular $ x - ] - Nothing -> docEmpty - ] - lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate - [ docCommaSep - , appSep $ docLit $ fText - , case fDoc of - Just x -> docSeq [ appSep $ docLit $ Text.pack "=" - , docAddBaseY BrIndentRegular x + , ( True + , docSetParSpacing + $ docAddBaseY BrIndentRegular + $ docPar + (docNodeAnnKW lexpr Nothing $ rExprDoc) + (docNonBottomSpacing $ docLines $ let + line1 = docCols ColRecUpdate + [ appSep $ docLit $ Text.pack "{" + , docWrapNodePrior rF1f $ appSep $ docLit $ rF1n + , docWrapNodeRest rF1f $ case rF1e of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular $ x ] - Nothing -> docEmpty - ] - lineN = docSeq - [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty - , docLit $ Text.pack "}" - ] - in [line1] ++ lineR ++ [lineN]) + Nothing -> docEmpty + ] + lineR = rFr <&> \(lfield, fText, fDoc) -> docWrapNode lfield $ docCols ColRecUpdate + [ docCommaSep + , appSep $ docLit $ fText + , case fDoc of + Just x -> docSeq [ appSep $ docLit $ Text.pack "=" + , docAddBaseY BrIndentRegular x + ] + Nothing -> docEmpty + ] + lineN = docSeq + [ docNodeAnnKW lexpr (Just AnnOpenC) docEmpty + , docLit $ Text.pack "}" + ] + in [line1] ++ lineR ++ [lineN]) + ) ] #if MIN_VERSION_ghc(8,2,0) /* ghc-8.2 */ ExprWithTySig exp1 (HsWC _ (HsIB _ typ1 _)) -> do @@ -959,7 +965,7 @@ layoutExpr lexpr@(L _ expr) = do docSeq [ docLit $ Text.pack "[" , docForceSingleline e1Doc - , docCommaSep + , appSep $ docLit $ Text.pack "," , appSep $ docForceSingleline e2Doc , docLit $ Text.pack "..]" ] @@ -980,7 +986,7 @@ layoutExpr lexpr@(L _ expr) = do docSeq [ docLit $ Text.pack "[" , docForceSingleline e1Doc - , docCommaSep + , appSep $ docLit $ Text.pack "," , appSep $ docForceSingleline e2Doc , appSep $ docLit $ Text.pack ".." , docForceSingleline eNDoc From d7ac478fc66662bcdc7eba80c4d1478b932f3490 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 16:11:28 -0500 Subject: [PATCH 13/22] Update type operator pending tests to remove context. --- src-literatetests/tests-context-free.blt | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 58b6406..6865862 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -198,12 +198,14 @@ func #test type operator stuff #pending test050 :: a :+: b -test051 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd -test052 :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test051 + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd +test052 + :: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + :+: lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + -> lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd ############################################################################### From ba3d9ad7393b57f69b5b7df76132dd156153f842 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sun, 19 Nov 2017 17:36:29 -0500 Subject: [PATCH 14/22] Add tests for record construction. --- src-literatetests/15-regressions.blt | 20 ++++++++++++++++++-- src-literatetests/tests-context-free.blt | 22 ++++++++++++++++++++-- 2 files changed, 38 insertions(+), 4 deletions(-) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index bea97cc..b521072 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -31,7 +31,7 @@ func = do func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent state - , _lstate_indent = _lstate_indent state + , _lstate_foo = _lstate_foo state } #test record update indentation 3 @@ -39,7 +39,23 @@ func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - , _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 1 +func = Foo {_lstate_indent = _lstate_indent state} + +#test record construction 2 +func = Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_fooo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 3 +func = do + Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd } #test post-indent comment diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 6865862..f5ab85c 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -650,7 +650,7 @@ func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent state - , _lstate_indent = _lstate_indent state + , _lstate_foo = _lstate_foo state } #test record update indentation 3 @@ -658,7 +658,25 @@ func = do s <- mGet mSet $ s { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd - , _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo kasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 1 +func = Foo + { _lstate_indent = _lstate_indent state + } + +#test record construction 2 +func = Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + } + +#test record construction 3 +func = do + Foo + { _lstate_indent = _lstate_indent lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd + , _lstate_foo = _lstate_foo lkasdlkjalsdjlakjsdlkjasldkjalskdjlkajsd } #test post-indent comment From 35f33c131cea6e9918dda0d937c997cf7aea8a3d Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sat, 25 Nov 2017 20:24:41 -0500 Subject: [PATCH 15/22] Remove duplication in 'let' expression layout. --- .../Brittany/Internal/Layouters/Expr.hs | 100 ++++++++---------- 1 file changed, 46 insertions(+), 54 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 86e86ac..c3f4429 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -567,65 +567,57 @@ layoutExpr lexpr@(L _ expr) = do (docSetBaseY $ expDoc1) ] ] - Just bindDocs@(_:_) -> docAlt $ - case indentPolicy of - IndentPolicyLeft -> - --either - -- let - -- a = b - -- c = d - -- in foo - -- bar - -- baz - --or - -- let - -- a = b - -- c = d - -- in - -- fooooooooooooooooooo - [ docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docSeq - [ docLit $ Text.pack "in " - , docAddBaseY BrIndentRegular $ expDoc1 - ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) + Just bindDocs@(_:_) -> docAltFilter + --either + -- let + -- a = b + -- c = d + -- in foo + -- bar + -- baz + --or + -- let + -- a = b + -- c = d + -- in + -- fooooooooooooooooooo + [ ( indentPolicy == IndentPolicyLeft + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docSeq + [ docLit $ Text.pack "in " + , docAddBaseY BrIndentRegular $ expDoc1 ] ] - _ -> - [ docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 - ] + ) + , ( indentPolicy /= IndentPolicyLeft + , docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - , docAddBaseY BrIndentRegular - $ docPar - (docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 ] ] + ) + , ( True + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + , docAddBaseY BrIndentRegular + $ docPar + (docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] + ) + ] _ -> docSeq [appSep $ docLit $ Text.pack "let in", expDoc1] -- docSeq [appSep $ docLit "let in", expDoc1] HsDo DoExpr (L _ stmts) _ -> do From de0851f97537132559cd65d7d3347e4a8a5989cb Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sat, 25 Nov 2017 20:34:07 -0500 Subject: [PATCH 16/22] Use docAltFilter for consistency. --- .../Brittany/Internal/Layouters/Stmt.hs | 24 ++++++++++--------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 6f95585..e1cf215 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -64,17 +64,19 @@ layoutStmt lstmt@(L _ stmt) = do (docLit $ Text.pack "let") (docSetBaseAndIndent $ return bindDoc) ] - Just bindDocs -> - let letSeq = docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ docLines $ return <$> bindDocs - ] - letRegular = docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ docLines $ return <$> bindDocs) - in case indentPolicy of - IndentPolicyLeft -> docAlt [letRegular] - _ -> docAlt [letSeq, letRegular] + Just bindDocs -> docAltFilter + [ ( indentPolicy /= IndentPolicyLeft + , docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ docLines $ return <$> bindDocs + ] + ) + , ( True + , docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ docLines $ return <$> bindDocs) + ) + ] RecStmt stmts _ _ _ _ _ _ _ _ _ -> do docSeq [ docLit (Text.pack "rec") From e9a2de7a85593c0c89fda522df4362efb1f06f13 Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Sat, 25 Nov 2017 20:50:17 -0500 Subject: [PATCH 17/22] Filter binders with docSetBaseAndIndent. --- src-literatetests/tests-context-free.blt | 27 +++++---- .../Brittany/Internal/Layouters/Expr.hs | 56 ++++++++++--------- .../Brittany/Internal/Layouters/Stmt.hs | 28 ++++++---- 3 files changed, 63 insertions(+), 48 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index f5ab85c..34f314b 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -532,7 +532,8 @@ func = do #test let func = do - let x = 13 + let + x = 13 stmt x @@ -1021,7 +1022,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] | not hasComments , [(guards, body, _bodyRaw)] <- [clauseDocs] - , let guardPart = singleLineGuardsDoc guards + , let + guardPart = singleLineGuardsDoc guards , wherePart <- case mWhereDocs of Nothing -> return @[] $ docEmpty Just [w] -> return @[] $ docSeq @@ -1042,7 +1044,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ wherePartMultiLine | [(guards, body, _bodyRaw)] <- [clauseDocs] - , let guardPart = singleLineGuardsDoc guards + , let + guardPart = singleLineGuardsDoc guards , Data.Maybe.isJust mWhereDocs ] ++ -- two-line solution + where in next line(s) @@ -1054,18 +1057,20 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ wherePartMultiLine | [(guards, body, _bodyRaw)] <- [clauseDocs] - , let guardPart = singleLineGuardsDoc guards + , let + guardPart = singleLineGuardsDoc guards ] #test comment-testcase-17 {-# LANGUAGE MultiWayIf #-} func = do - let foo = if - | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO - -> max - (defLen - 0.2) -- TODO - (defLen * 0.8) - | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO + let + foo = if + | Constuctoooooooooooooooooooooooooooooooooooor `elem` artics -- TODO + -> max + (defLen - 0.2) -- TODO + (defLen * 0.8) + | otherwise -> max (defLen - 0.05) (defLen * 0.95) -- TODO return True #test issue 49 @@ -1109,7 +1114,7 @@ foo = ## from the input; i cannot really express this yet with the current ## test-suite. ## #test ayaz -## +## ## myManageHook = ## composeOne [isFullscreen -?> doFullFloat, isDialog -?> doFloat, transience] ## <+> composeAll diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index c3f4429..38f3808 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -539,33 +539,39 @@ layoutExpr lexpr@(L _ expr) = do -- if "let" is moved horizontally as part of the transformation, as the -- comments before the first let item are moved horizontally with it. docSetIndentLevel $ case mBindDocs of - Just [bindDoc] -> docAlt - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , appSep $ docForceSingleline $ return bindDoc - , appSep $ docLit $ Text.pack "in" - , docForceSingleline $ expDoc1 - ] - , docLines - [ docSeq - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] + Just [bindDoc] -> docAltFilter + [ ( indentPolicy /= IndentPolicyLeft , docSeq - [ appSep $ docLit $ Text.pack "in " - , docSetBaseY $ expDoc1 + [ appSep $ docLit $ Text.pack "let" + , appSep $ docForceSingleline $ return bindDoc + , appSep $ docLit $ Text.pack "in" + , docForceSingleline $ expDoc1 ] - ] - , docLines - [ docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - , docAddBaseY BrIndentRegular - $ docPar - (appSep $ docLit $ Text.pack "in") - (docSetBaseY $ expDoc1) - ] + ) + , ( indentPolicy /= IndentPolicyLeft + , docLines + [ docSeq + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ return bindDoc + ] + , docSeq + [ appSep $ docLit $ Text.pack "in " + , docSetBaseY $ expDoc1 + ] + ] + ) + , ( True + , docLines + [ docAddBaseY BrIndentRegular + $ docPar + (appSep $ docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) + , docAddBaseY BrIndentRegular + $ docPar + (appSep $ docLit $ Text.pack "in") + (docSetBaseY $ expDoc1) + ] + ) ] Just bindDocs@(_:_) -> docAltFilter --either diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index e1cf215..5bd33d3 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -50,19 +50,23 @@ layoutStmt lstmt@(L _ stmt) = do ] LetStmt binds -> layoutLocalBinds binds >>= \case Nothing -> docLit $ Text.pack "let" -- i just tested - -- it, and it is - -- indeed allowed. - -- heh. + -- it, and it is + -- indeed allowed. + -- heh. Just [] -> docLit $ Text.pack "let" -- this probably never happens - Just [bindDoc] -> docAlt - [ docCols - ColDoLet - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] - , docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) + Just [bindDoc] -> docAltFilter + [ ( indentPolicy /= IndentPolicyLeft + , docCols + ColDoLet + [ appSep $ docLit $ Text.pack "let" + , docSetBaseAndIndent $ return bindDoc + ] + ) + , ( True + , docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) + ) ] Just bindDocs -> docAltFilter [ ( indentPolicy /= IndentPolicyLeft From f6859d184fd3479b8fdd74f74334405295dcfade Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Mon, 27 Nov 2017 13:05:04 -0500 Subject: [PATCH 18/22] Fix tests after rebase. --- src-literatetests/10-tests.blt | 2 +- src-literatetests/tests-context-free.blt | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 03b1c6b..962a2cb 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -227,7 +227,7 @@ func {-# LANGUAGE ScopedTypeVariables #-} func :: forall m - . ColMap2 + . ColMap2 -> ColInfo -> ColInfo -> ColInfo diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 34f314b..5048175 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -663,9 +663,7 @@ func = do } #test record construction 1 -func = Foo - { _lstate_indent = _lstate_indent state - } +func = Foo {_lstate_indent = _lstate_indent state} #test record construction 2 func = Foo From 9e8571b848d8e3f2f68f98a7b73621fe7a7fea52 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 27 Nov 2017 23:00:26 +0100 Subject: [PATCH 19/22] Remove an unnecessary node in BriDoc construction; Add TODO --- src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index 38f3808..d108ed1 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -419,6 +419,8 @@ layoutExpr lexpr@(L _ expr) = do case indentPolicy of IndentPolicyLeft -> BrIndentRegular _ -> BrIndentSpecial 3 + -- TODO: some of the alternatives (especially last and last-but-one) + -- overlap. docAltFilter [ -- if _ then _ else _ (,) (not hasComments) @@ -447,8 +449,7 @@ layoutExpr lexpr@(L _ expr) = do $ docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar - ( docAddBaseY maySpecialIndent - $ docSeq + ( docSeq [ docNodeAnnKW lexpr Nothing $ appSep $ docLit $ Text.pack "if" , docNodeAnnKW lexpr (Just AnnIf) $ docForceSingleline ifExprDoc ]) From 466ff237ff4d9417aecc77ba05acdd784dd8674b Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 27 Nov 2017 23:05:47 +0100 Subject: [PATCH 20/22] Add some comments/examples in layoutStmt --- .../Brittany/Internal/Layouters/Stmt.hs | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 5bd33d3..3cc40f1 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -55,27 +55,37 @@ layoutStmt lstmt@(L _ stmt) = do -- heh. Just [] -> docLit $ Text.pack "let" -- this probably never happens Just [bindDoc] -> docAltFilter - [ ( indentPolicy /= IndentPolicyLeft + [ -- let bind = expr + ( indentPolicy /= IndentPolicyLeft , docCols ColDoLet [ appSep $ docLit $ Text.pack "let" , docSetBaseAndIndent $ return bindDoc ] ) - , ( True + , -- let + -- bind = expr + ( True , docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") (docSetBaseAndIndent $ return bindDoc) ) ] Just bindDocs -> docAltFilter - [ ( indentPolicy /= IndentPolicyLeft + [ -- let aaa = expra + -- bbb = exprb + -- ccc = exprc + ( indentPolicy /= IndentPolicyLeft , docSeq [ appSep $ docLit $ Text.pack "let" , docSetBaseAndIndent $ docLines $ return <$> bindDocs ] ) - , ( True + , -- let + -- aaa = expra + -- bbb = exprb + -- ccc = exprc + ( True , docAddBaseY BrIndentRegular $ docPar (docLit $ Text.pack "let") (docSetBaseAndIndent $ docLines $ return <$> bindDocs) From d9155e240d72135294e2a21079d1d17214a08333 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 27 Nov 2017 23:09:14 +0100 Subject: [PATCH 21/22] RecursiveDo: Add second layout, Respect IndentPolicyLeft --- .../Brittany/Internal/Layouters/Stmt.hs | 27 ++++++++++++++----- 1 file changed, 21 insertions(+), 6 deletions(-) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index 3cc40f1..c9494e3 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -91,12 +91,27 @@ layoutStmt lstmt@(L _ stmt) = do (docSetBaseAndIndent $ docLines $ return <$> bindDocs) ) ] - RecStmt stmts _ _ _ _ _ _ _ _ _ -> do - docSeq - [ docLit (Text.pack "rec") - , docSeparator - , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts - ] + RecStmt stmts _ _ _ _ _ _ _ _ _ -> docAltFilter + [ -- rec stmt1 + -- stmt2 + -- stmt3 + ( indentPolicy /= IndentPolicyLeft + , docSeq + [ docLit (Text.pack "rec") + , docSeparator + , docSetBaseAndIndent $ docLines $ layoutStmt <$> stmts + ] + ) + , -- rec + -- stmt1 + -- stmt2 + -- stmt3 + ( True + , docAddBaseY BrIndentRegular $ docPar + (docLit (Text.pack "rec")) + (docLines $ layoutStmt <$> stmts) + ) + ] BodyStmt expr _ _ _ -> do expDoc <- docSharedWrapper layoutExpr expr docAddBaseY BrIndentRegular $ expDoc From 882a3b1a7a7851b36fb147580ad36eda2d28abc6 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Mon, 27 Nov 2017 23:27:33 +0100 Subject: [PATCH 22/22] Allow single-line after let with IndentPolicyLeft --- src-literatetests/tests-context-free.blt | 12 +++---- .../Brittany/Internal/Layouters/Expr.hs | 2 +- .../Brittany/Internal/Layouters/Stmt.hs | 31 +++++++++---------- 3 files changed, 20 insertions(+), 25 deletions(-) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 5048175..5f5765a 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -532,8 +532,7 @@ func = do #test let func = do - let - x = 13 + let x = 13 stmt x @@ -1020,8 +1019,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] | not hasComments , [(guards, body, _bodyRaw)] <- [clauseDocs] - , let - guardPart = singleLineGuardsDoc guards + , let guardPart = singleLineGuardsDoc guards , wherePart <- case mWhereDocs of Nothing -> return @[] $ docEmpty Just [w] -> return @[] $ docSeq @@ -1042,8 +1040,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ wherePartMultiLine | [(guards, body, _bodyRaw)] <- [clauseDocs] - , let - guardPart = singleLineGuardsDoc guards + , let guardPart = singleLineGuardsDoc guards , Data.Maybe.isJust mWhereDocs ] ++ -- two-line solution + where in next line(s) @@ -1055,8 +1052,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ wherePartMultiLine | [(guards, body, _bodyRaw)] <- [clauseDocs] - , let - guardPart = singleLineGuardsDoc guards + , let guardPart = singleLineGuardsDoc guards ] #test comment-testcase-17 diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs index d108ed1..4b96241 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs @@ -541,7 +541,7 @@ layoutExpr lexpr@(L _ expr) = do -- comments before the first let item are moved horizontally with it. docSetIndentLevel $ case mBindDocs of Just [bindDoc] -> docAltFilter - [ ( indentPolicy /= IndentPolicyLeft + [ ( True , docSeq [ appSep $ docLit $ Text.pack "let" , appSep $ docForceSingleline $ return bindDoc diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs index c9494e3..b8814cd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Stmt.hs @@ -54,22 +54,22 @@ layoutStmt lstmt@(L _ stmt) = do -- indeed allowed. -- heh. Just [] -> docLit $ Text.pack "let" -- this probably never happens - Just [bindDoc] -> docAltFilter + Just [bindDoc] -> docAlt [ -- let bind = expr - ( indentPolicy /= IndentPolicyLeft - , docCols - ColDoLet - [ appSep $ docLit $ Text.pack "let" - , docSetBaseAndIndent $ return bindDoc - ] - ) + docCols + ColDoLet + [ appSep $ docLit $ Text.pack "let" + , ( if indentPolicy == IndentPolicyLeft + then docForceSingleline + else docSetBaseAndIndent + ) + $ return bindDoc + ] , -- let -- bind = expr - ( True - , docAddBaseY BrIndentRegular $ docPar - (docLit $ Text.pack "let") - (docSetBaseAndIndent $ return bindDoc) - ) + docAddBaseY BrIndentRegular $ docPar + (docLit $ Text.pack "let") + (docSetBaseAndIndent $ return bindDoc) ] Just bindDocs -> docAltFilter [ -- let aaa = expra @@ -107,9 +107,8 @@ layoutStmt lstmt@(L _ stmt) = do -- stmt2 -- stmt3 ( True - , docAddBaseY BrIndentRegular $ docPar - (docLit (Text.pack "rec")) - (docLines $ layoutStmt <$> stmts) + , docAddBaseY BrIndentRegular + $ docPar (docLit (Text.pack "rec")) (docLines $ layoutStmt <$> stmts) ) ] BodyStmt expr _ _ _ -> do