From 21c080572b39fb4307edfe19107998a2a2b4f2d9 Mon Sep 17 00:00:00 2001 From: sniperrifle2004 Date: Thu, 21 Dec 2017 23:51:27 +0100 Subject: [PATCH] Add compact version of import layout Also let layoutLLIEs deal with comments --- src-literatetests/10-tests.blt | 11 ++ src-literatetests/tests-context-free.blt | 117 ++++++++---------- .../Haskell/Brittany/Internal/Layouters/IE.hs | 34 ++--- .../Brittany/Internal/Layouters/Import.hs | 93 ++++++++------ .../Brittany/Internal/Layouters/Module.hs | 18 +-- 5 files changed, 144 insertions(+), 129 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 123eccc..758efe0 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -704,6 +704,17 @@ import TestJustShortEnoughModuleNameLike hiding ( ) import TestJustAbitToLongModuleNameLikeTh hiding ( ) +import MoreThanSufficientlyLongModuleNameWithSome + ( items + , that + , will + , not + , fit + , inA + , compact + , layout + ) + 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 8be4666..a48890a 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -667,25 +667,25 @@ module Main (Test()) where ############################################################################### #test simple-import -import Data.List +import Data.List #test simple-import-alias -import Data.List as L +import Data.List as L #test simple-qualified-import import qualified Data.List #test simple-qualified-import-alias -import qualified Data.List as L +import qualified Data.List as L #test simple-safe -import safe Data.List as L +import safe Data.List as L #test simple-source -import {-# SOURCE #-} Data.List ( ) +import {-# SOURCE #-} Data.List () #test simple-safe-qualified -import safe qualified Data.Lis hiding ( nub ) +import safe qualified Data.List hiding (nub) #test simple-safe-qualified-source import {-# SOURCE #-} safe qualified Data.List @@ -694,88 +694,82 @@ import {-# SOURCE #-} safe qualified Data.List import qualified "base" Data.List #test qualifier-effect -import {-# SOURCE #-} safe qualified "base" Data.List as L -import {-# SOURCE #-} safe qualified "base" Data.List ( ) -import {-# SOURCE #-} safe qualified Data.List hiding ( ) +import {-# SOURCE #-} safe qualified "base" Data.List as L +import {-# SOURCE #-} safe qualified "base" Data.List () +import {-# SOURCE #-} safe qualified Data.List hiding () #test instances-only -import qualified Data.List ( ) +import qualified Data.List () #test one-element -import Data.List ( nub ) +import Data.List (nub) #test several-elements -import Data.List ( nub - , foldl' - , indexElem - ) +import Data.List (nub, foldl', indexElem) #test with-things -import Test ( T - , T2() - , T3(..) - , T4(T4) - , T5(T5, t5) - , T6((<|>)) - , (+) - ) +import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+)) #test hiding -import Test hiding ( ) -import Test as T - hiding ( ) +import Test hiding () +import Test as T hiding () #test long-module-name -import TestJustShortEnoughModuleNameLikeThisOne ( ) -import TestJustAbitToLongModuleNameLikeThisOneIs - ( ) -import TestJustShortEnoughModuleNameLikeThisOn as T -import TestJustAbitToLongModuleNameLikeThisOneI - as T -import TestJustShortEnoughModuleNameLike hiding ( ) -import TestJustAbitToLongModuleNameLikeTh - hiding ( ) +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 import-with-comments -- Test -import Data.List ( nub ) -- Test +import Data.List (nub) -- Test {- Test -} -import qualified Data.List as L - ( foldl' ) {- Test -} +import qualified Data.List as L (foldl') {- Test -} #test import-with-comments-2 -import Test ( abc - , def - -- comment - ) +import Test ( abc + , def + -- comment + ) #test import-with-comments-3 -import Test ( abc - -- comment - ) +import Test ( abc + -- comment + ) #test import-with-comments-4 -import Test ( abc - -- comment - , def - , ghi - {- comment -} - , jkl - -- comment - ) +import Test ( abc + -- comment + , def + , ghi + {- comment -} + , jkl + -- comment + ) -- Test -import Test ( test ) +import Test (test) #test import-with-comments-5 -import Test ( -- comment - ) +import Test ( -- comment + ) #test long-bindings -import Test ( longbindingNameThatoverflowsColum ) -import Test ( Long(List, Of, Things) ) +import Test (longbindingNameThatoverflowsColum) +import Test (Long(List, Of, Things)) #test preamble full-preamble {-# LANGUAGE BangPatterns #-} @@ -800,13 +794,12 @@ module Test where -- Test -import Data.List ( nub ) -- Test +import Data.List (nub) -- Test {- Test -} -import qualified Data.List as L - ( foldl' ) {- Test -} +import qualified Data.List as L (foldl') {- Test -} -- Test -import Test ( test ) +import Test (test) ############################################################################### ############################################################################### diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index bce0a4a..262108e 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -47,12 +47,10 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of IEThingWith _ _ ns fs -> docSeq $ [ien, docLit $ Text.pack "("] - ++ ( intersperse docCommaSep - (map ((docLit =<<) . lrdrNameToTextAnn . prepareName) ns) - ++ intersperse docCommaSep (map prepareFL fs) - ) + ++ intersperse docCommaSep (map nameDoc ns ++ map prepareFL fs) ++ [docLit $ Text.pack ")"] where + nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName prepareFL = docLit . Text.pack . FastString.unpackFS . flLabel . unLoc IEModuleContents n -> docSeq [ docLit $ Text.pack "module" @@ -64,8 +62,8 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of -- Helper function to deal with Located lists of LIEs. -- In particular this will also associate documentation --- from the LIES that actually belongs to the last IE. --- It also add docCommaSep to all but he last element +-- from the located list that actually belongs to the last IE. +-- It also adds docCommaSep to all but the first element -- This configuration allows both vertical and horizontal -- handling of the resulting list. Adding parens is -- left to the caller since that is context sensitive @@ -90,17 +88,25 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do -- ... -- , item -- ) --- Empty lists will always be rendered as () +-- If the llies contains comments the list will +-- always expand over multiple lines, even when empty: +-- () -- no comments +-- ( -- a comment +-- ) layoutLLIEs :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered layoutLLIEs llies = do ieDs <- layoutAnnAndSepLLIEs llies + hasComments <- hasAnyCommentsBelow llies case ieDs of - [] -> docLit $ Text.pack "()" + [] -> docAltFilter + [ (not hasComments, docLit $ Text.pack "()") + , (otherwise, docPar (docSeq [docParenLSep, docWrapNode llies docEmpty]) + $ docLines [docParenR]) + ] (ieDsH:ieDsT) -> - docAlt - [ docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR] - , docLines $ - docSeq [docParenLSep, ieDsH] - : ieDsT - ++ [docParenR] + docAltFilter + [ (not hasComments, docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR]) + , (otherwise, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) $ + docLines $ ieDsT + ++ [docParenR]) ] diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index 7aac868..97284a8 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -44,23 +44,23 @@ prepModName = id layoutImport :: ToBriDoc ImportDecl layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of - ImportDecl _ (L _ modName) pkg src safe q False as mllies -> do + ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack + indentPolicy <- mAsk <&> _conf_layout .> _lconfig_indentPolicy .> confUnpack -- NB we don't need to worry about sharing in the below code -- (docSharedWrapper etc.) because we do not use any docAlt nodes; all -- "decisions" are made statically. let + compact = indentPolicy == IndentPolicyLeft modNameT = Text.pack $ moduleNameString modName pkgNameT = Text.pack . prepPkg . sl_st <$> pkg - asT = Text.pack . moduleNameString . prepModName <$> as - hiding = case mllies of - Just (h, _) -> h - Nothing -> False + masT = Text.pack . moduleNameString . prepModName <$> mas + hiding = maybe False fst mllies minQLength = length "import qualified " qLengthReal = let qualifiedPart = if q then length "qualified " else 0 safePart = if safe then length "safe " else 0 - pkgPart = fromMaybe 0 ((+ 1) . Text.length <$> pkgNameT) + pkgPart = maybe 0 ((+ 1) . Text.length) pkgNameT srcPart = if src then length "{-# SOURCE #-} " else 0 in length "import " + srcPart + safePart + qualifiedPart + pkgPart qLength = max minQLength qLengthReal @@ -73,49 +73,60 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty - , fromMaybe docEmpty (appSep . docLit <$> pkgNameT) + , maybe docEmpty (appSep . docLit) pkgNameT ] + indentName = + if compact then id else docEnsureIndent (BrIndentSpecial qLength) modNameD = - docEnsureIndent (BrIndentSpecial qLength) $ appSep $ docLit modNameT + indentName $ appSep $ docLit modNameT hidDoc = if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty importHead = docSeq [importQualifiers, modNameD] bindingsD = case mllies of - Nothing -> docSeq [docEmpty] + Nothing -> docEmpty Just (_, llies) -> do - ieDs <- layoutAnnAndSepLLIEs llies hasComments <- hasAnyCommentsBelow 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] -> if hasComments - then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR - else docSeq [hidDoc, docParenLSep, ieD, docSeparator, docParenR] - -- ..[hiding].( b - -- , b' - -- ) - (ieD:ieDs') -> - docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]) - $ docLines - $ ieDs' - ++ [docParenR] + if compact + then docSeq [hidDoc, layoutLLIEs 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] -> if hasComments + then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR + else docSeq [hidDoc, docParenLSep, ieD, docSeparator, docParenR] + -- ..[hiding].( b + -- , b' + -- ) + (ieD:ieDs') -> + docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]) + $ docLines + $ ieDs' + ++ [docParenR] bindingLine = docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD - case asT of - Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine] - | otherwise -> docLines [importHead, asDoc, bindingLine] - where - enoughRoom = nameCost < importCol - asCost - asDoc = - docEnsureIndent (BrIndentSpecial (importCol - asCost)) - $ docSeq - $ [appSep $ docLit $ Text.pack "as", docLit n] - Nothing | enoughRoom -> docSeq [importHead, bindingLine] - | otherwise -> docLines [importHead, bindingLine] - where enoughRoom = nameCost < importCol - bindingCost + makeAsDoc asT = + docSeq [appSep $ docLit $ Text.pack "as", appSep $ docLit asT] + if compact + then + let asDoc = maybe docEmpty makeAsDoc masT + in docSeq [importHead, asDoc, docSetBaseY $ bindingsD] + else + case masT of + Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine] + | otherwise -> docLines [importHead, asDoc, bindingLine] + where + enoughRoom = nameCost < importCol - asCost + asDoc = + docEnsureIndent (BrIndentSpecial (importCol - asCost)) + $ makeAsDoc n + Nothing | enoughRoom -> docSeq [importHead, bindingLine] + | otherwise -> docLines [importHead, bindingLine] + where enoughRoom = nameCost < importCol - bindingCost _ -> docEmpty diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs index c0f569b..db2e2af 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs @@ -24,31 +24,25 @@ import Language.Haskell.Brittany.Internal.Utils layoutModule :: ToBriDoc HsModule -layoutModule lmod@(L _ mod') = do +layoutModule lmod@(L _ mod') = case mod' of -- Implicit module Main HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports HsModule (Just n) les imports _ _ _ -> do - let tn = Text.pack $ moduleNameString $ unLoc n - (hasComments, exportsDoc) <- case les of - Nothing -> return (False, docEmpty) - Just llies -> do - hasComments <- hasAnyCommentsBelow llies - exportsDoc <- docSharedWrapper layoutLLIEs llies - return (hasComments, exportsDoc) + let tn = Text.pack $ moduleNameString $ unLoc n + exportsDoc = maybe docEmpty layoutLLIEs les docLines $ docSeq - [ docWrapNode lmod $ docEmpty + [ docWrapNode lmod docEmpty -- A pseudo node that serves merely to force documentation -- before the node , docAlt - ( [ docSeq + ( [ docForceSingleline $ docSeq [ appSep $ docLit $ Text.pack "module" , appSep $ docLit tn - , appSep $ docForceSingleline exportsDoc + , appSep exportsDoc , docLit $ Text.pack "where" ] - | not hasComments ] ++ [ docLines [ docAddBaseY BrIndentRegular $ docPar