From c3b6e172614eb53468fb8cec50000b99b3681c2b Mon Sep 17 00:00:00 2001 From: sniperrifle2004 Date: Mon, 18 Dec 2017 12:01:22 +0100 Subject: [PATCH] Improve layout for imports --- src-literatetests/10-tests.blt | 88 ++++++++------ src-literatetests/tests-context-free.blt | 79 +++++++------ .../Brittany/Internal/Layouters/Import.hs | 108 +++++++++++------- 3 files changed, 166 insertions(+), 109 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 6b838a3..97a5463 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -617,22 +617,22 @@ 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 +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.List @@ -643,48 +643,69 @@ import {-# SOURCE #-} safe qualified Data.List #test simple-qualified-package 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 ( ) + #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)) +import Test ( T + , T2() + , T3(..) + , T4(T4) + , T5(T5, t5) + ) #test hiding -import Test hiding () -import Test as T hiding () +import Test hiding ( ) +import Test as T + hiding ( ) -#test horizontal-layout -import Data.List (nub) -import qualified Data.List as L (foldl') +#test long-module-name +import TestJustShortEnoughModuleNameLikeThisOne ( ) +import TestJustAbitToLongModuleNameLikeThisOneIs + ( ) -import Test (test) -import Main hiding - ( main - , test1 - , test2 - , test3 - , test4 - , test5 - , test6 - , test7 - , test8 - , test9 - ) +import TestJustShortEnoughModuleNameLikeThisOn as T +import TestJustAbitToLongModuleNameLikeThisOneI + as T + +import TestJustShortEnoughModuleNameLike hiding ( ) +import TestJustAbitToLongModuleNameLikeTh + hiding ( ) + +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( ) +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe + ( ) + +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAf as T +import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff + as T +import {-# SOURCE #-} safe qualified "qualifier" A hiding ( ) +import {-# SOURCE #-} safe qualified "qualifiers" A + hiding ( ) #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 Test (test) +import Test ( test ) #test preamble full-preamble {-# LANGUAGE BangPatterns #-} @@ -709,9 +730,10 @@ 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-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index c588436..f9b4eb6 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -665,25 +665,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 +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.List +import safe qualified Data.Lis hiding ( nub ) #test simple-safe-qualified-source import {-# SOURCE #-} safe qualified Data.List @@ -691,48 +691,56 @@ import {-# SOURCE #-} safe qualified Data.List #test simple-qualified-package 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 ( ) + #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)) +import Test ( T + , T2() + , T3(..) + , T4(T4) + , T5(T5, t5) + ) #test hiding -import Test hiding () -import Test as T hiding () +import Test hiding ( ) +import Test as T + hiding ( ) -#test horizontal-layout -import Data.List (nub) -import qualified Data.List as L (foldl') - -import Test (test) -import Main hiding - ( main - , test1 - , test2 - , test3 - , test4 - , test5 - , test6 - , test7 - , test8 - , test9 - ) +#test long-module-name +import TestJustShortEnoughModuleNameLikeThisOne ( ) +import TestJustAbitToLongModuleNameLikeThisOneIs + ( ) +import TestJustShortEnoughModuleNameLikeThisOn as T +import TestJustAbitToLongModuleNameLikeThisOneI + as T +import TestJustShortEnoughModuleNameLike hiding ( ) +import TestJustAbitToLongModuleNameLikeTh + hiding ( ) #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 Test (test) +import Test ( test ) #test preamble full-preamble {-# LANGUAGE BangPatterns #-} @@ -757,12 +765,13 @@ 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/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index ea5d49c..83343bb 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -7,17 +7,14 @@ import Language.Haskell.Brittany.Internal.LayouterBasics import Language.Haskell.Brittany.Internal.Layouters.IE import Language.Haskell.Brittany.Internal.Config.Types -import RdrName (RdrName(..)) -import GHC ( unLoc - , runGhc - , GenLocated(L) - , moduleNameString - , AnnKeywordId(..) - , Located - ) +import RdrName ( RdrName(..) ) +import GHC ( unLoc + , GenLocated(L) + , moduleNameString + , Located + ) import HsSyn import Name -import HsImpExp import FieldLabel import qualified FastString import BasicTypes @@ -28,12 +25,11 @@ import Language.Haskell.Brittany.Internal.Utils #if MIN_VERSION_ghc(8,2,0) prepPkg :: SourceText -> String -prepPkg rawN = - case rawN of - SourceText n -> n - -- This would be odd to encounter and the - -- result will most certainly be wrong - NoSourceText -> "" +prepPkg rawN = case rawN of + SourceText n -> n + -- This would be odd to encounter and the + -- result will most certainly be wrong + NoSourceText -> "" #else prepPkg :: String -> String prepPkg = id @@ -49,11 +45,26 @@ prepModName = id layoutImport :: ToBriDoc ImportDecl layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of ImportDecl _ (L _ modName) pkg src safe q False as llies -> do + importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack let - modNameT = Text.pack $ moduleNameString modName - pkgNameT = Text.pack . prepPkg . sl_st <$> pkg - - asT = Text.pack . moduleNameString . prepModName <$> as + modNameT = Text.pack $ moduleNameString modName + pkgNameT = Text.pack . prepPkg . sl_st <$> pkg + asT = Text.pack . moduleNameString . prepModName <$> as + (hiding, mlies) = case llies of + Just (h, L _ lies') -> (h, Just lies') + Nothing -> (False, Nothing) + 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) + srcPart = if src then length "{-# SOURCE #-} " else 0 + in length "import " + srcPart + safePart + qualifiedPart + pkgPart + qLength = max minQLength qLengthReal + -- Cost in columns of importColumn + asCost = length "as " + bindingCost = if hiding then length "hiding ( " else length "( " + nameCost = Text.length modNameT + qLength importQualifiers = docSeq [ appSep $ docLit $ Text.pack "import" , if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty @@ -61,26 +72,41 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty , fromMaybe docEmpty (appSep . docLit <$> pkgNameT) ] - makeAs asT' = - appSep $ docSeq [docLit (Text.pack "as"), docSeparator, docLit asT'] - importIds = - docSeq $ [appSep $ docLit modNameT, fromMaybe docEmpty (makeAs <$> asT)] - (hiding, ies) <- case llies of - Just (h, L _ lies) -> do - sies <- docSharedWrapper layoutIEList lies - return (h, sies) - Nothing -> return (False, docEmpty) - h <- docSharedWrapper - ( const - ( docSeq - [ docCols ColImport [importQualifiers, importIds] - , if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty - ] - ) - ) - () - docAlt - [ docSeq [h, docForceSingleline ies] - , docAddBaseY BrIndentRegular $ docPar h (docForceMultiline ies) - ] + modNameD = + docEnsureIndent (BrIndentSpecial qLength) $ appSep $ docLit modNameT + hidDoc = + if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty + importHead = docSeq [importQualifiers, modNameD] + Just lies = mlies + (ieH:ieT) = map layoutIE lies + makeIENode ie = docSeq [docCommaSep, ie] + bindings@(bindingsH:bindingsT) = + docSeq [docParenLSep, ieH] + : map makeIENode ieT + ++ [docSeq [docSeparator, docParenR]] + bindingsD = case mlies of + Nothing -> docSeq [docEmpty] + -- ..[hiding].( ) + Just [] -> docSeq [hidDoc, docParenLSep, docParenR] + -- ..[hiding].( b ) + Just [_] -> docSeq $ hidDoc : bindings + -- ..[hiding].( b + -- , b' + -- ) + Just _ -> + docPar (docSeq [hidDoc, docSetBaseY $ bindingsH]) $ docLines bindingsT + 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 _ -> docEmpty