From 99e5aacb5e3019a75205c8e8daae1d9341c04fb8 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Thu, 20 Apr 2023 21:35:33 +0000 Subject: [PATCH] Discard special case for non-nested OpApp --- data/15-regressions.blt | 32 ++++++----- data/30-tests-context-free.blt | 31 +++++----- .../Brittany/Internal/Components/OpTree.hs | 5 ++ .../Brittany/Internal/ToBriDoc/Expr.hs | 56 +------------------ .../Brittany/Internal/ToBriDoc/OpTree.hs | 5 +- 5 files changed, 43 insertions(+), 86 deletions(-) diff --git a/data/15-regressions.blt b/data/15-regressions.blt index 972ad84..eee9c08 100644 --- a/data/15-regressions.blt +++ b/data/15-regressions.blt @@ -237,7 +237,8 @@ showPackageDetailedInfo pkginfo = , entry "Cached" haveTarball alwaysShow dispYesNo , if not (hasLib pkginfo) then empty - else text "Modules:" + else + text "Modules:" $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo)) ] @@ -303,18 +304,18 @@ 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) - ] - ] + $ [ 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 @@ -445,8 +446,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ -- two-line solution + where in next line(s) [ docLines - $ [ docForceSingleline - $ docSeq (patPartInline ++ [guardPart, return binderDoc]) + $ [ docForceSingleline $ docSeq + (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body @@ -872,6 +873,7 @@ instance HasDependencies SomeDataModel where = (SomeOtherDataModelId, SomeOtherOtherDataModelId) #test stupid-do-operator-combination +#pending func = do diff --git a/data/30-tests-context-free.blt b/data/30-tests-context-free.blt index 9751027..bbed630 100644 --- a/data/30-tests-context-free.blt +++ b/data/30-tests-context-free.blt @@ -1176,7 +1176,8 @@ showPackageDetailedInfo pkginfo = , entry "Cached" haveTarball alwaysShow dispYesNo , if not (hasLib pkginfo) then empty - else text "Modules:" + else + text "Modules:" $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo)) ] @@ -1249,18 +1250,18 @@ 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) - ] - ] + $ [ 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 @@ -1370,8 +1371,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do ] ++ -- two-line solution + where in next line(s) [ docLines - $ [ docForceSingleline - $ docSeq (patPartInline ++ [guardPart, return binderDoc]) + $ [ docForceSingleline $ docSeq + (patPartInline ++ [guardPart, return binderDoc]) , docEnsureIndent BrIndentRegular $ docForceSingleline $ return body diff --git a/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs index 446a52a..c008191 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs +++ b/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs @@ -223,7 +223,9 @@ hardcodedFixity allowUnqualify = \case "!" -> Just $ Fixity NoSourceText 9 InfixL "//" -> Just $ Fixity NoSourceText 9 InfixL "<>" -> Just $ Fixity NoSourceText 6 InfixR + "<+>" -> Just $ Fixity NoSourceText 5 InfixR "<$" -> Just $ Fixity NoSourceText 4 InfixL + "$>" -> Just $ Fixity NoSourceText 4 InfixL "<$>" -> Just $ Fixity NoSourceText 4 InfixL "<&>" -> Just $ Fixity NoSourceText 1 InfixL "&" -> Just $ Fixity NoSourceText 1 InfixL @@ -245,6 +247,7 @@ hardcodedFixity allowUnqualify = \case "`shiftR`" -> Just $ Fixity NoSourceText 8 InfixL "`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL "`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL + "+#" -> Just $ Fixity NoSourceText 6 InfixL ".^." -> Just $ Fixity NoSourceText 6 InfixL ".>>." -> Just $ Fixity NoSourceText 8 InfixL ".<<." -> Just $ Fixity NoSourceText 8 InfixL @@ -265,6 +268,8 @@ hardcodedFixity allowUnqualify = \case ".>" -> Just $ Fixity NoSourceText 9 InfixL ":?" -> Just $ Fixity NoSourceText 7 InfixN ":-" -> Just $ Fixity NoSourceText 9 InfixR + ".:" -> Just $ Fixity NoSourceText 9 InfixR + ".=" -> Just $ Fixity NoSourceText 8 InfixR str -> case (Safe.headMay str, Safe.lastMay str) of (Just '\'', _) -> hardcodedFixity False (drop 1 str) diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs index cd4f322..b66d31e 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Expr.hs @@ -220,7 +220,7 @@ layoutExpr lexpr@(L _ expr) = do ] , docPar e (docSeq [docLit $ Text.pack "@", t]) ] - OpApp _topEpAnn _expLeft@(L _ OpApp{}) _expOp _expRight -> do + OpApp _topEpAnn _expLeft _expOp _expRight -> do -- let -- allowPar = case (expOp, expRight) of -- (L _ (HsVar _ (L _ (Unqual occname))), _) @@ -235,60 +235,6 @@ layoutExpr lexpr@(L _ expr) = do treeAndHasComms <- layout_gatherOpTreeE layouters False False id Nothing Nothing [] lexpr layout_opTree layouters treeAndHasComms - OpApp epAnn expLeft expOp expRight -> docHandleComms epAnn $ do - expDocLeft <- shareDoc $ layoutExpr expLeft - expDocOp <- shareDoc $ layoutExpr expOp - expDocRight <- shareDoc $ layoutExpr expRight - let - allowPar = case (expOp, expRight) of - (L _ (HsVar _ (L _ (Unqual occname))), _) - | occNameString occname == "$" -> True - (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False - _ -> True - let leftIsDoBlock = case expLeft of - L _ HsDo{} -> True - _ -> False - runFilteredAlternative $ do - -- one-line - addAlternative $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceSingleline expDocRight - ] - -- -- line + freely indented block for right expression - -- addAlternative - -- $ docSeq - -- [ appSep $ docForceSingleline expDocLeft - -- , appSep $ docForceSingleline expDocOp - -- , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight - -- ] - -- two-line - addAlternative $ do - let expDocOpAndRight = docForceSingleline $ docCols - ColOpPrefix - [appSep $ expDocOp, docSetBaseY expDocRight] - if leftIsDoBlock - then docLines [expDocLeft, expDocOpAndRight] - else docAddBaseY BrIndentRegular - $ docPar expDocLeft expDocOpAndRight - -- TODO: in both cases, we don't force expDocLeft to be - -- single-line, which has certain.. interesting consequences. - -- At least, the "two-line" label is not entirely - -- accurate. - -- one-line + par - addAlternativeCond allowPar $ docSeq - [ appSep $ docForceSingleline expDocLeft - , appSep $ docForceSingleline expDocOp - , docForceParSpacing expDocRight - ] - -- more lines - addAlternative $ do - let expDocOpAndRight = - docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight] - if leftIsDoBlock - then docLines [expDocLeft, expDocOpAndRight] - else docAddBaseY BrIndentRegular - $ docPar expDocLeft expDocOpAndRight NegApp _ op _ -> do opDoc <- shareDoc $ layoutExpr op docSeq [docLit $ Text.pack "-", opDoc] diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs index 0863aec..d43a82f 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs +++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs @@ -258,7 +258,10 @@ layoutOpTree allowSinglelinePar = \case -- or -- > one + two + case x of -- > _ -> three - addAlternativeCond allowSinglelinePar $ wrapParenIfSl hasParen $ docSeq + addAlternativeCond allowSinglelinePar + $ wrapParenIfSl hasParen + $ docSetParSpacing + $ docSeq ([docForceSingleline docL] ++ case splitFirstLast sharedOps of FirstLastEmpty -> [] FirstLastSingleton (od, ed) ->