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

Add compact version of import layout 

Also let layoutLLIEs deal with comments
pull/83/head
sniperrifle2004 2017-12-21 23:51:27 +01:00
parent 82a5ffb3b3
commit 21c080572b
5 changed files with 144 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -704,6 +704,17 @@ import TestJustShortEnoughModuleNameLike hiding ( )
import TestJustAbitToLongModuleNameLikeTh import TestJustAbitToLongModuleNameLikeTh
hiding ( ) hiding ( )
import MoreThanSufficientlyLongModuleNameWithSome
( items
, that
, will
, not
, fit
, inA
, compact
, layout
)
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( ) import {-# SOURCE #-} safe qualified "qualifiers" AlsoAff ( )
import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe import {-# SOURCE #-} safe qualified "qualifiers" AlsoAffe
( ) ( )

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

@ -667,25 +667,25 @@ module Main (Test()) where
############################################################################### ###############################################################################
#test simple-import #test simple-import
import Data.List import Data.List
#test simple-import-alias #test simple-import-alias
import Data.List as L import Data.List as L
#test simple-qualified-import #test simple-qualified-import
import qualified Data.List import qualified Data.List
#test simple-qualified-import-alias #test simple-qualified-import-alias
import qualified Data.List as L import qualified Data.List as L
#test simple-safe #test simple-safe
import safe Data.List as L 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.Lis hiding ( nub ) import safe qualified Data.List hiding (nub)
#test simple-safe-qualified-source #test simple-safe-qualified-source
import {-# SOURCE #-} safe qualified Data.List import {-# SOURCE #-} safe qualified Data.List
@ -694,88 +694,82 @@ import {-# SOURCE #-} safe qualified Data.List
import qualified "base" Data.List import qualified "base" Data.List
#test qualifier-effect #test qualifier-effect
import {-# SOURCE #-} safe qualified "base" Data.List as L import {-# SOURCE #-} safe qualified "base" Data.List as L
import {-# SOURCE #-} safe qualified "base" Data.List ( ) import {-# SOURCE #-} safe qualified "base" Data.List ()
import {-# SOURCE #-} safe qualified Data.List hiding ( ) 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 import Data.List (nub, foldl', indexElem)
, foldl'
, indexElem
)
#test with-things #test with-things
import Test ( T import Test (T, T2(), T3(..), T4(T4), T5(T5, t5), T6((<|>)), (+))
, T2()
, T3(..)
, T4(T4)
, T5(T5, t5)
, T6((<|>))
, (+)
)
#test hiding #test hiding
import Test hiding ( ) import Test hiding ()
import Test as T import Test as T hiding ()
hiding ( )
#test long-module-name #test long-module-name
import TestJustShortEnoughModuleNameLikeThisOne ( ) import TestJustShortEnoughModuleNameLikeThisOne ()
import TestJustAbitToLongModuleNameLikeThisOneIs import TestJustAbitToLongModuleNameLikeThisOneIs ()
( ) import TestJustShortEnoughModuleNameLikeThisOn as T
import TestJustShortEnoughModuleNameLikeThisOn as T import TestJustAbitToLongModuleNameLikeThisOneI as T
import TestJustAbitToLongModuleNameLikeThisOneI import TestJustShortEnoughModuleNameLike hiding ()
as T import TestJustAbitToLongModuleNameLikeTh hiding ()
import TestJustShortEnoughModuleNameLike hiding ( ) import MoreThanSufficientlyLongModuleNameWithSome ( items
import TestJustAbitToLongModuleNameLikeTh , that
hiding ( ) , will
, not
, fit
, inA
, compact
, layout
)
#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 import qualified Data.List as L (foldl') {- Test -}
( foldl' ) {- Test -}
#test import-with-comments-2 #test import-with-comments-2
import Test ( abc import Test ( abc
, def , def
-- comment -- comment
) )
#test import-with-comments-3 #test import-with-comments-3
import Test ( abc import Test ( abc
-- comment -- comment
) )
#test import-with-comments-4 #test import-with-comments-4
import Test ( abc import Test ( abc
-- comment -- comment
, def , def
, ghi , ghi
{- comment -} {- comment -}
, jkl , jkl
-- comment -- comment
) )
-- Test -- Test
import Test ( test ) import Test (test)
#test import-with-comments-5 #test import-with-comments-5
import Test ( -- comment import Test ( -- comment
) )
#test long-bindings #test long-bindings
import Test ( longbindingNameThatoverflowsColum ) import Test (longbindingNameThatoverflowsColum)
import Test ( Long(List, Of, Things) ) import Test (Long(List, Of, Things))
#test preamble full-preamble #test preamble full-preamble
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
@ -800,13 +794,12 @@ module Test
where where
-- Test -- Test
import Data.List ( nub ) -- Test import Data.List (nub) -- Test
{- Test -} {- Test -}
import qualified Data.List as L import qualified Data.List as L (foldl') {- Test -}
( foldl' ) {- Test -}
-- Test -- Test
import Test ( test ) import Test (test)
############################################################################### ###############################################################################
############################################################################### ###############################################################################

34
src/Language/Haskell/Brittany/Internal/Layouters/IE.hs
View File

@ -47,12 +47,10 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
IEThingWith _ _ ns fs -> IEThingWith _ _ ns fs ->
docSeq docSeq
$ [ien, docLit $ Text.pack "("] $ [ien, docLit $ Text.pack "("]
++ ( intersperse docCommaSep ++ intersperse docCommaSep (map nameDoc ns ++ map prepareFL fs)
(map ((docLit =<<) . lrdrNameToTextAnn . prepareName) ns)
++ intersperse docCommaSep (map prepareFL fs)
)
++ [docLit $ Text.pack ")"] ++ [docLit $ Text.pack ")"]
where where
nameDoc = (docLit =<<) . lrdrNameToTextAnn . prepareName
prepareFL = docLit . Text.pack . FastString.unpackFS . flLabel . unLoc prepareFL = docLit . Text.pack . FastString.unpackFS . flLabel . unLoc
IEModuleContents n -> docSeq IEModuleContents n -> docSeq
[ docLit $ Text.pack "module" [ 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. -- Helper function to deal with Located lists of LIEs.
-- In particular this will also associate documentation -- In particular this will also associate documentation
-- from the LIES that actually belongs to the last IE. -- from the located list that actually belongs to the last IE.
-- It also add docCommaSep to all but he last element -- It also adds docCommaSep to all but the first element
-- This configuration allows both vertical and horizontal -- This configuration allows both vertical and horizontal
-- handling of the resulting list. Adding parens is -- handling of the resulting list. Adding parens is
-- left to the caller since that is context sensitive -- left to the caller since that is context sensitive
@ -90,17 +88,25 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do
-- ... -- ...
-- , item -- , 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 :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs llies = do layoutLLIEs llies = do
ieDs <- layoutAnnAndSepLLIEs llies ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies
case ieDs of case ieDs of
[] -> docLit $ Text.pack "()" [] -> docAltFilter
[ (not hasComments, docLit $ Text.pack "()")
, (otherwise, docPar (docSeq [docParenLSep, docWrapNode llies docEmpty])
$ docLines [docParenR])
]
(ieDsH:ieDsT) -> (ieDsH:ieDsT) ->
docAlt docAltFilter
[ docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR] [ (not hasComments, docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR])
, docLines $ , (otherwise, docPar (docSetBaseY $ docSeq [docParenLSep, ieDsH]) $
docSeq [docParenLSep, ieDsH] docLines $ ieDsT
: ieDsT ++ [docParenR])
++ [docParenR]
] ]

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

@ -44,23 +44,23 @@ 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 mllies -> do ImportDecl _ (L _ modName) pkg src safe q False mas mllies -> do
importCol <- mAsk <&> _conf_layout .> _lconfig_importColumn .> confUnpack 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 -- NB we don't need to worry about sharing in the below code
-- (docSharedWrapper etc.) because we do not use any docAlt nodes; all -- (docSharedWrapper etc.) because we do not use any docAlt nodes; all
-- "decisions" are made statically. -- "decisions" are made statically.
let let
compact = indentPolicy == IndentPolicyLeft
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 masT = Text.pack . moduleNameString . prepModName <$> mas
hiding = case mllies of hiding = maybe False fst mllies
Just (h, _) -> h
Nothing -> False
minQLength = length "import qualified " minQLength = length "import qualified "
qLengthReal = qLengthReal =
let qualifiedPart = if q then length "qualified " else 0 let qualifiedPart = if q then length "qualified " else 0
safePart = if safe then length "safe " 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 srcPart = if src then length "{-# SOURCE #-} " else 0
in length "import " + srcPart + safePart + qualifiedPart + pkgPart in length "import " + srcPart + safePart + qualifiedPart + pkgPart
qLength = max minQLength qLengthReal 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 src then appSep $ docLit $ Text.pack "{-# SOURCE #-}" else docEmpty
, if safe then appSep $ docLit $ Text.pack "safe" else docEmpty , if safe then appSep $ docLit $ Text.pack "safe" else docEmpty
, 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) , maybe docEmpty (appSep . docLit) pkgNameT
] ]
indentName =
if compact then id else docEnsureIndent (BrIndentSpecial qLength)
modNameD = modNameD =
docEnsureIndent (BrIndentSpecial qLength) $ appSep $ docLit modNameT indentName $ appSep $ docLit modNameT
hidDoc = hidDoc =
if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty
importHead = docSeq [importQualifiers, modNameD] importHead = docSeq [importQualifiers, modNameD]
bindingsD = case mllies of bindingsD = case mllies of
Nothing -> docSeq [docEmpty] Nothing -> docEmpty
Just (_, llies) -> do Just (_, llies) -> do
ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies hasComments <- hasAnyCommentsBelow llies
docWrapNodeRest llies $ case ieDs of if compact
-- ..[hiding].( ) then docSeq [hidDoc, layoutLLIEs llies]
[] -> if hasComments else do
then docPar ieDs <- layoutAnnAndSepLLIEs llies
(docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) docWrapNodeRest llies $ case ieDs of
docParenR -- ..[hiding].( )
else docSeq [hidDoc, docParenLSep, docSeparator, docParenR] [] -> if hasComments
-- ..[hiding].( b ) then docPar
[ieD] -> if hasComments (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty])
then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR docParenR
else docSeq [hidDoc, docParenLSep, ieD, docSeparator, docParenR] else docSeq [hidDoc, docParenLSep, docSeparator, docParenR]
-- ..[hiding].( b -- ..[hiding].( b )
-- , b' [ieD] -> if hasComments
-- ) then docPar (docSeq [hidDoc, docParenLSep, ieD]) docParenR
(ieD:ieDs') -> else docSeq [hidDoc, docParenLSep, ieD, docSeparator, docParenR]
docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]]) -- ..[hiding].( b
$ docLines -- , b'
$ ieDs' -- )
++ [docParenR] (ieD:ieDs') ->
docPar (docSeq [hidDoc, docSetBaseY $ docSeq [docParenLSep, ieD]])
$ docLines
$ ieDs'
++ [docParenR]
bindingLine = bindingLine =
docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD
case asT of makeAsDoc asT =
Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine] docSeq [appSep $ docLit $ Text.pack "as", appSep $ docLit asT]
| otherwise -> docLines [importHead, asDoc, bindingLine] if compact
where then
enoughRoom = nameCost < importCol - asCost let asDoc = maybe docEmpty makeAsDoc masT
asDoc = in docSeq [importHead, asDoc, docSetBaseY $ bindingsD]
docEnsureIndent (BrIndentSpecial (importCol - asCost)) else
$ docSeq case masT of
$ [appSep $ docLit $ Text.pack "as", docLit n] Just n | enoughRoom -> docLines [docSeq [importHead, asDoc], bindingLine]
Nothing | enoughRoom -> docSeq [importHead, bindingLine] | otherwise -> docLines [importHead, asDoc, bindingLine]
| otherwise -> docLines [importHead, bindingLine] where
where enoughRoom = nameCost < importCol - bindingCost 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 _ -> docEmpty

18
src/Language/Haskell/Brittany/Internal/Layouters/Module.hs
View File

@ -24,31 +24,25 @@ import Language.Haskell.Brittany.Internal.Utils
layoutModule :: ToBriDoc HsModule layoutModule :: ToBriDoc HsModule
layoutModule lmod@(L _ mod') = do layoutModule lmod@(L _ mod') =
case mod' of case mod' of
-- Implicit module Main -- Implicit module Main
HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports HsModule Nothing _ imports _ _ _ -> docLines $ map layoutImport imports
HsModule (Just n) les imports _ _ _ -> do HsModule (Just n) les imports _ _ _ -> do
let tn = Text.pack $ moduleNameString $ unLoc n let tn = Text.pack $ moduleNameString $ unLoc n
(hasComments, exportsDoc) <- case les of exportsDoc = maybe docEmpty layoutLLIEs les
Nothing -> return (False, docEmpty)
Just llies -> do
hasComments <- hasAnyCommentsBelow llies
exportsDoc <- docSharedWrapper layoutLLIEs llies
return (hasComments, exportsDoc)
docLines docLines
$ docSeq $ docSeq
[ docWrapNode lmod $ docEmpty [ docWrapNode lmod docEmpty
-- A pseudo node that serves merely to force documentation -- A pseudo node that serves merely to force documentation
-- before the node -- before the node
, docAlt , docAlt
( [ docSeq ( [ docForceSingleline $ docSeq
[ appSep $ docLit $ Text.pack "module" [ appSep $ docLit $ Text.pack "module"
, appSep $ docLit tn , appSep $ docLit tn
, appSep $ docForceSingleline exportsDoc , appSep exportsDoc
, docLit $ Text.pack "where" , docLit $ Text.pack "where"
] ]
| not hasComments
] ]
++ [ docLines ++ [ docLines
[ docAddBaseY BrIndentRegular $ docPar [ docAddBaseY BrIndentRegular $ docPar