From d634d34ff1ee83c7925e21639c8c0e60f6faf4a3 Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Fri, 23 Mar 2018 15:41:41 +0100 Subject: [PATCH] Fix module-import-hiding-items layout --- src-literatetests/10-tests.blt | 19 +++- src-literatetests/tests-context-free.blt | 21 ++++- .../Haskell/Brittany/Internal/Config/Types.hs | 2 + .../Brittany/Internal/Layouters/Import.hs | 93 ++++++++++--------- .../Internal/Transformations/Floating.hs | 4 +- 5 files changed, 89 insertions(+), 50 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 3410785..4919f3f 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -734,19 +734,22 @@ import Test hiding ( ) import Test as T hiding ( ) -#test long-module-name +#test long-module-name-simple import TestJustShortEnoughModuleNameLikeThisOne ( ) import TestJustAbitToLongModuleNameLikeThisOneIs ( ) +#test long-module-name-as import TestJustShortEnoughModuleNameLikeThisOn as T import TestJustAbitToLongModuleNameLikeThisOneI as T +#test long-module-name-hiding import TestJustShortEnoughModuleNameLike hiding ( ) import TestJustAbitToLongModuleNameLikeTh hiding ( ) +#test long-module-name-simple-items import MoreThanSufficientlyLongModuleNameWithSome ( items , that @@ -758,6 +761,20 @@ import MoreThanSufficientlyLongModuleNameWithSome , layout ) +#test long-module-name-hiding-items +import TestJustShortEnoughModuleNameLike hiding ( abc + , def + , ghci + , jklm + ) +import TestJustAbitToLongModuleNameLikeTh + hiding ( abc + , def + , ghci + , jklm + ) + +#test long-module-name-other import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( ) import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe ( ) diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 8ab4d7e..2d1c421 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -736,16 +736,27 @@ import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+)) import Test hiding () import Test as T hiding () -#test long-module-name +#test long-module-name-simple import TestJustShortEnoughModuleNameLikeThisOne () import TestJustAbitToLongModuleNameLikeThisOneIs () -import TestJustShortEnoughModuleNameLikeThisOn as T -import TestJustAbitToLongModuleNameLikeThisOneI as T -import TestJustShortEnoughModuleNameLike hiding () -import TestJustAbitToLongModuleNameLikeTh hiding () import MoreThanSufficientlyLongModuleNameWithSome (items, that, will, not, fit, inA, compact, layout) +#test long-module-name-as +import TestJustShortEnoughModuleNameLikeThisOn as T +import TestJustAbitToLongModuleNameLikeThisOneI as T + +#test long-module-name-hiding +import TestJustShortEnoughModuleNameLike hiding () +import TestJustAbitToLongModuleNameLikeTh hiding () + +#test long-module-name-simple-items +import MoreThanSufficientlyLongModuleNameWithSome + (items, that, will, not, fit, inA, compact, layout) + +#test long-module-name-hiding-items +import TestJustShortEnoughModuleNameLike hiding (abc, def, ghci, jklm) + #test import-with-comments -- Test import Data.List (nub) -- Test diff --git a/src/Language/Haskell/Brittany/Internal/Config/Types.hs b/src/Language/Haskell/Brittany/Internal/Config/Types.hs index 03f7d9a..dc0300f 100644 --- a/src/Language/Haskell/Brittany/Internal/Config/Types.hs +++ b/src/Language/Haskell/Brittany/Internal/Config/Types.hs @@ -56,9 +56,11 @@ data CLayoutConfig f = LayoutConfig , _lconfig_importColumn :: f (Last Int) -- ^ for import statement layouting, column at which to align the -- elements to be imported from a module. + -- It is expected that importAsColumn >= importCol. , _lconfig_importAsColumn :: f (Last Int) -- ^ for import statement layouting, column at which put the module's -- "as" name (which also affects the positioning of the "as" keyword). + -- It is expected that importAsColumn >= importCol. , _lconfig_altChooser :: f (Last AltChooser) , _lconfig_columnAlignMode :: f (Last ColumnAlignMode) , _lconfig_alignmentLimit :: f (Last Int) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index a98f642..04925bd 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -64,7 +64,7 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of qLength = max minQLength qLengthReal -- Cost in columns of importColumn asCost = length "as " - bindingCost = if hiding then length "hiding ( " else length "( " + hidingParenCost = if hiding then length "hiding ( " else length "( " nameCost = Text.length modNameT + qLength importQualifiers = docSeq [ appSep $ docLit $ Text.pack "import" @@ -77,8 +77,11 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of if compact then id else docEnsureIndent (BrIndentSpecial qLength) modNameD = indentName $ appSep $ docLit modNameT - hidDoc = - if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty + hidDocCol = if hiding then importCol - hidingParenCost else importCol - 2 + hidDocColDiff = importCol - 2 - hidDocCol + hidDoc = if hiding + then appSep $ docLit $ Text.pack "hiding" + else docEmpty importHead = docSeq [importQualifiers, modNameD] bindingsD = case mllies of Nothing -> docEmpty @@ -88,40 +91,43 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of then docSeq [hidDoc, layoutLLIEs True llies] else do ieDs <- layoutAnnAndSepLLIEs llies - docWrapNodeRest llies $ case ieDs of - -- ..[hiding].( ) - [] -> if hasComments - then docPar - (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) - docParenR - else docSeq [hidDoc, docParenLSep, docSeparator, docParenR] - -- ..[hiding].( b ) - [ieD] -> docAltFilter - [ ( not hasComments - , docSeq - [ hidDoc - , docParenLSep - , docForceSingleline $ ieD - , docSeparator - , docParenR - ] - ) - , ( otherwise - , docPar - (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD]) - docParenR - ) - ] - -- ..[hiding].( b - -- , b' - -- ) - (ieD:ieDs') -> - docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]) - $ docLines - $ ieDs' - ++ [docParenR] - bindingLine = - docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD + docWrapNodeRest llies + $ docEnsureIndent (BrIndentSpecial hidDocCol) + $ case ieDs of + -- ..[hiding].( ) + [] -> if hasComments + then docPar + (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) + (docEnsureIndent (BrIndentSpecial hidDocColDiff) $ docParenR) + else docSeq [hidDoc, docParenLSep, docSeparator, docParenR] + -- ..[hiding].( b ) + [ieD] -> docAltFilter + [ ( not hasComments + , docSeq + [ hidDoc + , docParenLSep + , docForceSingleline $ ieD + , docSeparator + , docParenR + ] + ) + , ( otherwise + , docPar + (docSeq [hidDoc, docParenLSep, docNonBottomSpacing ieD]) + (docEnsureIndent (BrIndentSpecial hidDocColDiff) docParenR) + ) + ] + -- ..[hiding].( b + -- , b' + -- ) + (ieD:ieDs') -> + docPar + (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]) + ( docEnsureIndent (BrIndentSpecial hidDocColDiff) + $ docLines + $ ieDs' + ++ [docParenR] + ) makeAsDoc asT = docSeq [appSep $ docLit $ Text.pack "as", appSep $ docLit asT] if compact @@ -134,14 +140,17 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of ] else case masT of - Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine] - | otherwise -> docLines [importHead, asDoc, bindingLine] + Just n -> if enoughRoom + then docLines + [ docSeq [importHead, asDoc], bindingsD] + else docLines [importHead, asDoc, bindingsD] where enoughRoom = nameCost < importAsCol - asCost asDoc = docEnsureIndent (BrIndentSpecial (importAsCol - asCost)) $ makeAsDoc n - Nothing | enoughRoom -> docSeq [importHead, bindingLine] - | otherwise -> docLines [importHead, bindingLine] - where enoughRoom = nameCost < importCol - bindingCost + Nothing -> if enoughRoom + then docSeq [importHead, bindingsD] + else docLines [importHead, bindingsD] + where enoughRoom = nameCost < importCol - hidingParenCost _ -> docEmpty diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs index e36a545..08a919f 100644 --- a/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs +++ b/src/Language/Haskell/Brittany/Internal/Transformations/Floating.hs @@ -101,9 +101,9 @@ transformSimplifyFloating = stepBO .> stepFull Just $ BDDebug s (BDIndentLevelPop x) _ -> Nothing descendAddB = transformDownMay $ \case - -- AddIndent floats into Lines. BDAddBaseY BrIndentNone x -> Just x + -- AddIndent floats into Lines. BDAddBaseY indent (BDLines lines) -> Just $ BDLines $ BDAddBaseY indent <$> lines -- AddIndent floats into last column @@ -145,9 +145,9 @@ transformSimplifyFloating = stepBO .> stepFull x -> x stepFull = -- traceFunctionWith "stepFull" (show . briDocToDocWithAnns) (show . briDocToDocWithAnns) $ Uniplate.rewrite $ \case - -- AddIndent floats into Lines. BDAddBaseY BrIndentNone x -> Just $ x + -- AddIndent floats into Lines. BDAddBaseY indent (BDLines lines) -> Just $ BDLines $ BDAddBaseY indent <$> lines -- AddIndent floats into last column