hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

Improve layout for imports

pull/83/head
sniperrifle2004 2017-12-18 12:01:22 +01:00
parent 204f0aff08
commit c3b6e17261
3 changed files with 166 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

82
src-literatetests/10-tests.blt
View File

@ -629,10 +629,10 @@ import qualified Data.List
import qualified Data.List as L import qualified Data.List as L
#test simple-safe #test simple-safe
import safe Data.List import safe Data.List as L
#test simple-source #test simple-source
import {-# SOURCE #-} Data.List import {-# SOURCE #-} Data.List ( )
#test simple-safe-qualified #test simple-safe-qualified
import safe qualified Data.List import safe qualified Data.List
@ -643,48 +643,69 @@ import {-# SOURCE #-} safe qualified Data.List
#test simple-qualified-package #test simple-qualified-package
import qualified "base" 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 ( )
#test instances-only #test instances-only
import qualified Data.List () import qualified Data.List ( )
#test one-element #test one-element
import Data.List (nub) import Data.List ( nub )
#test several-elements #test several-elements
import Data.List (nub, foldl', indexElem) import Data.List ( nub
, foldl'
, indexElem
)
#test with-things #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 #test hiding
import Test hiding () import Test hiding ( )
import Test as T hiding () import Test as T
hiding ( )
#test horizontal-layout #test long-module-name
import Data.List (nub) import TestJustShortEnoughModuleNameLikeThisOne ( )
import qualified Data.List as L (foldl') import TestJustAbitToLongModuleNameLikeThisOneIs
( )
import Test (test) import TestJustShortEnoughModuleNameLikeThisOn as T
import Main hiding import TestJustAbitToLongModuleNameLikeThisOneI
( main as T
, test1
, test2 import TestJustShortEnoughModuleNameLike hiding ( )
, test3 import TestJustAbitToLongModuleNameLikeTh
, test4 hiding ( )
, test5
, test6 import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
, test7 import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
, test8 ( )
, test9
) 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-with-comments
-- Test -- Test
import Data.List (nub) -- Test import Data.List ( nub ) -- Test
{- Test -} {- Test -}
import qualified Data.List as L (foldl') {- Test -} import qualified Data.List as L
( foldl' ) {- Test -}
-- Test -- Test
import Test (test) import Test ( test )
#test preamble full-preamble #test preamble full-preamble
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
@ -709,9 +730,10 @@ module Test
where where
-- Test -- Test
import Data.List (nub) -- Test import Data.List ( nub ) -- Test
{- Test -} {- Test -}
import qualified Data.List as L (foldl') {- Test -} import qualified Data.List as L
( foldl' ) {- Test -}
-- Test -- Test
import Test (test) import Test ( test )

73
src-literatetests/tests-context-free.blt
View File

@ -677,13 +677,13 @@ import qualified Data.List
import qualified Data.List as L import qualified Data.List as L
#test simple-safe #test simple-safe
import safe Data.List import safe Data.List as L
#test simple-source #test simple-source
import {-# SOURCE #-} Data.List import {-# SOURCE #-} Data.List ( )
#test simple-safe-qualified #test simple-safe-qualified
import safe qualified Data.List import safe qualified Data.Lis hiding ( nub )
#test simple-safe-qualified-source #test simple-safe-qualified-source
import {-# SOURCE #-} safe qualified Data.List import {-# SOURCE #-} safe qualified Data.List
@ -691,48 +691,56 @@ import {-# SOURCE #-} safe qualified Data.List
#test simple-qualified-package #test simple-qualified-package
import qualified "base" 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 ( )
#test instances-only #test instances-only
import qualified Data.List () import qualified Data.List ( )
#test one-element #test one-element
import Data.List (nub) import Data.List ( nub )
#test several-elements #test several-elements
import Data.List (nub, foldl', indexElem) import Data.List ( nub
, foldl'
, indexElem
)
#test with-things #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 #test hiding
import Test hiding () import Test hiding ( )
import Test as T hiding () import Test as T
hiding ( )
#test horizontal-layout #test long-module-name
import Data.List (nub) import TestJustShortEnoughModuleNameLikeThisOne ( )
import qualified Data.List as L (foldl') import TestJustAbitToLongModuleNameLikeThisOneIs
( )
import Test (test) import TestJustShortEnoughModuleNameLikeThisOn as T
import Main hiding import TestJustAbitToLongModuleNameLikeThisOneI
( main as T
, test1 import TestJustShortEnoughModuleNameLike hiding ( )
, test2 import TestJustAbitToLongModuleNameLikeTh
, test3 hiding ( )
, test4
, test5
, test6
, test7
, test8
, test9
)
#test import-with-comments #test import-with-comments
-- Test -- Test
import Data.List (nub) -- Test import Data.List ( nub ) -- Test
{- Test -} {- Test -}
import qualified Data.List as L (foldl') {- Test -} import qualified Data.List as L
( foldl' ) {- Test -}
-- Test -- Test
import Test (test) import Test ( test )
#test preamble full-preamble #test preamble full-preamble
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
@ -757,12 +765,13 @@ module Test
where where
-- Test -- Test
import Data.List (nub) -- Test import Data.List ( nub ) -- Test
{- Test -} {- Test -}
import qualified Data.List as L (foldl') {- Test -} import qualified Data.List as L
( foldl' ) {- Test -}
-- Test -- Test
import Test (test) import Test ( test )
############################################################################### ###############################################################################
############################################################################### ###############################################################################

84
src/Language/Haskell/Brittany/Internal/Layouters/Import.hs
View File

@ -7,17 +7,14 @@ import Language.Haskell.Brittany.Internal.LayouterBasics
import Language.Haskell.Brittany.Internal.Layouters.IE import Language.Haskell.Brittany.Internal.Layouters.IE
import Language.Haskell.Brittany.Internal.Config.Types import Language.Haskell.Brittany.Internal.Config.Types
import RdrName (RdrName(..)) import RdrName ( RdrName(..) )
import GHC ( unLoc import GHC ( unLoc
, runGhc
, GenLocated(L) , GenLocated(L)
, moduleNameString , moduleNameString
, AnnKeywordId(..)
, Located , Located
) )
import HsSyn import HsSyn
import Name import Name
import HsImpExp
import FieldLabel import FieldLabel
import qualified FastString import qualified FastString
import BasicTypes import BasicTypes
@ -28,8 +25,7 @@ import Language.Haskell.Brittany.Internal.Utils
#if MIN_VERSION_ghc(8,2,0) #if MIN_VERSION_ghc(8,2,0)
prepPkg :: SourceText -> String prepPkg :: SourceText -> String
prepPkg rawN = prepPkg rawN = case rawN of
case rawN of
SourceText n -> n SourceText n -> n
-- This would be odd to encounter and the -- This would be odd to encounter and the
-- result will most certainly be wrong -- result will most certainly be wrong
@ -49,11 +45,26 @@ prepModName = id
layoutImport :: ToBriDoc ImportDecl layoutImport :: ToBriDoc ImportDecl
layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
ImportDecl _ (L _ modName) pkg src safe q False as llies -> do ImportDecl _ (L _ modName) pkg src safe q False as llies -> do
importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack
let let
modNameT = Text.pack $ moduleNameString modName modNameT = Text.pack $ moduleNameString modName
pkgNameT = Text.pack . prepPkg . sl_st <$> pkg pkgNameT = Text.pack . prepPkg . sl_st <$> pkg
asT = Text.pack . moduleNameString . prepModName <$> as 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 importQualifiers = docSeq
[ appSep $ docLit $ Text.pack "import" [ appSep $ docLit $ Text.pack "import"
, if src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty , 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 , if q then appSep $ docLit $ Text.pack "qualified" else docEmpty
, fromMaybe docEmpty (appSep . docLit <$> pkgNameT) , fromMaybe docEmpty (appSep . docLit <$> pkgNameT)
] ]
makeAs asT' = modNameD =
appSep $ docSeq [docLit (Text.pack "as"), docSeparator, docLit asT'] docEnsureIndent (BrIndentSpecial qLength) $ appSep $ docLit modNameT
importIds = hidDoc =
docSeq $ [appSep $ docLit modNameT, fromMaybe docEmpty (makeAs <$> asT)] if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
(hiding, ies) <- case llies of importHead = docSeq [importQualifiers, modNameD]
Just (h, L _ lies) -> do Just lies = mlies
sies <- docSharedWrapper layoutIEList lies (ieH:ieT) = map layoutIE lies
return (h, sies) makeIENode ie = docSeq [docCommaSep, ie]
Nothing -> return (False, docEmpty) bindings@(bindingsH:bindingsT) =
h <- docSharedWrapper docSeq [docParenLSep, ieH]
( const : map makeIENode ieT
( docSeq ++ [docSeq [docSeparator, docParenR]]
[ docCols ColImport [importQualifiers, importIds] bindingsD = case mlies of
, if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty Nothing -> docSeq [docEmpty]
] -- ..[hiding].( )
) Just [] -> docSeq [hidDoc, docParenLSep, docParenR]
) -- ..[hiding].( b )
() Just [_] -> docSeq $ hidDoc : bindings
docAlt -- ..[hiding].( b
[ docSeq [h, docForceSingleline ies] -- , b'
, docAddBaseY BrIndentRegular $ docPar h (docForceMultiline ies) -- )
] 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 _ -> docEmpty