Also fix export comments

Also refactored a little to improve reuse of the docWrapNode logic
pull/83/head
sniperrifle2004 2017-12-19 16:33:13 +01:00
parent a59df1f391
commit 162b6e6bfd
5 changed files with 94 additions and 63 deletions

View File

@ -583,6 +583,7 @@ where
#test exports-with-comments #test exports-with-comments
module Main module Main
( main ( main
-- main
, test1 , test1
, test2 , test2
-- Test 3 -- Test 3
@ -590,6 +591,7 @@ module Main
, test4 , test4
-- Test 5 -- Test 5
, test5 , test5
-- Test 6
) )
where where
@ -732,6 +734,14 @@ import Test ( abc
-- comment -- comment
) )
#test import-with-comments-5
import Test ( -- comment
)
#test long-bindings
import Test ( longbindingNameThatoverflowsColum )
import Test ( Long(List, Of, Things) )
#test preamble full-preamble #test preamble full-preamble
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
@ -751,6 +761,7 @@ module Test
, test8 , test8
, test9 , test9
, test10 , test10
-- Test 10
) )
where where

View File

@ -631,6 +631,7 @@ where
#test exports-with-comments #test exports-with-comments
module Main module Main
( main ( main
-- main
, test1 , test1
, test2 , test2
-- Test 3 -- Test 3
@ -638,6 +639,7 @@ module Main
, test4 , test4
-- Test 5 -- Test 5
, test5 , test5
-- Test 6
) )
where where
@ -767,6 +769,14 @@ import Test ( abc
-- Test -- Test
import Test ( test ) import Test ( test )
#test import-with-comments-5
import Test ( -- comment
)
#test long-bindings
import Test ( longbindingNameThatoverflowsColum )
import Test ( Long(List, Of, Things) )
#test preamble full-preamble #test preamble full-preamble
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}

View File

@ -1,6 +1,7 @@
module Language.Haskell.Brittany.Internal.Layouters.IE module Language.Haskell.Brittany.Internal.Layouters.IE
( layoutIE ( layoutIE
, layoutIEList , layoutLLIEs
, layoutAnnAndSepLLIEs
) )
where where
@ -61,20 +62,42 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of
_ -> docEmpty _ -> docEmpty
where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie) where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie)
layoutIEList :: [LIE RdrName] -> ToBriDocM BriDocNumbered -- Helper function to deal with Located lists of LIEs.
layoutIEList lies = do -- In particular this will also associate documentation
ies <- mapM (docSharedWrapper layoutIE) lies -- from the LIES that actually belongs to the last IE.
case ies of -- It also add docCommaSep to all but he last element
[] -> docLit $ Text.pack "()" -- This configuration allows both vertical and horizontal
xs@(x1:xr) -> docAlt -- handling of the resulting list. Adding parens is
[ docSeq -- left to the caller since that is context sensitive
[ docLit $ Text.pack "(" layoutAnnAndSepLLIEs :: (Located [LIE RdrName]) -> ToBriDocM [ToBriDocM BriDocNumbered]
, docSeq $ List.intersperse docCommaSep xs layoutAnnAndSepLLIEs llies@(L _ lies) = do
, docLit $ Text.pack ")" let makeIENode ie = docSeq [docCommaSep, ie]
layoutAnnAndSepLLIEs' ies = case ies of
[] -> []
[ie] -> [docWrapNode llies $ ie]
(ie:ies') -> ie:map makeIENode (List.init ies')
++ [makeIENode $ docWrapNode llies $ List.last ies']
layoutAnnAndSepLLIEs' <$> mapM (docSharedWrapper layoutIE) lies
-- Builds a complete layout for the given located
-- list of LIEs. The layout provides two alternatives:
-- (item, item, ..., item)
-- ( item
-- , item
-- ...
-- , item
-- )
-- Empty lists will always be rendered as ()
layoutLLIEs :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs llies = docWrapNodeRest llies $ do
ieDs <- layoutAnnAndSepLLIEs llies
case ieDs of
[] -> docLit $ Text.pack "()"
ieDs@(ieDsH:ieDsT) ->
docAlt
[ docSeq $ docLit (Text.pack "("):ieDs ++ [docParenR]
, docLines $
docSeq [docParenLSep, ieDsH]
: ieDsT
++ [docParenR]
] ]
, docLines
( [docSeq [docParenLSep, x1]]
++ [ docSeq [docCommaSep, x] | x <- xr ]
++ [docParenR]
)
]

View File

@ -50,9 +50,9 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
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 mllies of hiding = case mllies of
Just (h, L _ lies') -> (h, Just lies') Just (h, _) -> h
Nothing -> (False, Nothing) 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
@ -77,49 +77,36 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
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]
Just lies = mlies bindingsH = docParenLSep
Just (_, llies) = mllies bindingsT = [docSeq [docSeparator, docParenR]]
(ieH:ieT) = map layoutIE lies bindingsD = case mllies of
makeIENode ie = docSeq [docCommaSep, ie]
bindings@(bindingsH:bindingsT) =
docSeq [docParenLSep, ieH]
: bindingsT'
++ [docSeq [docSeparator, docParenR]]
where
-- Handle the last element with docWrapNode llies
bindingsT' =
case ieT of
[] -> []
[ie] -> [makeIENode $ docWrapNode llies $ ie]
_ -> map makeIENode (List.init ieT) ++ [makeIENode $ docWrapNode llies $ List.last ieT]
bindingsD = case mlies of
Nothing -> docSeq [docEmpty] Nothing -> docSeq [docEmpty]
-- ..[hiding].( ) Just (_, llies) -> do
Just [] -> do ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies hasComments <- hasAnyCommentsBelow llies
if hasComments case ieDs of
then -- ..[hiding].( )
docWrapNodeRest llies [] -> do
$ docPar if hasComments
(docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) then
$ docLines [docParenR] docWrapNodeRest llies $ docPar (docSeq [hidDoc, bindingsH, docWrapNode llies docEmpty]) $ docLines
else bindingsT
docWrapNodeRest llies $ docSeq [hidDoc, docParenLSep, docParenR] else
-- ..[hiding].( b ) docWrapNodeRest llies $ docSeq $ hidDoc : bindingsH : bindingsT
Just [_] -> do -- ..[hiding].( b )
hasComments <- hasAnyCommentsBelow llies [ieD] -> do
if hasComments if hasComments
then then
docWrapNodeRest llies $ docPar (docSeq [hidDoc, docWrapNode llies $ bindingsH]) $ docLines docWrapNodeRest llies $ docPar (docSeq [hidDoc, bindingsH, ieD ]) $ docLines $
bindingsT bindingsT
else else
docWrapNodeRest llies $ docSeq $ hidDoc : bindings docWrapNodeRest llies $ docSeq $ hidDoc : bindingsH : ieD : bindingsT
-- ..[hiding].( b -- ..[hiding].( b
-- , b' -- , b'
-- ) -- )
Just _ -> (ieD:ieDs') -> do
docWrapNodeRest llies $ docPar (docSeq [hidDoc, docSetBaseY $ bindingsH]) docWrapNodeRest llies $ docPar (docSeq [hidDoc, docSetBaseY $ docSeq [bindingsH, ieD]])
$ docLines bindingsT $ docLines $ ieDs' ++ bindingsT
bindingLine = bindingLine =
docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD
case asT of case asT of

View File

@ -32,9 +32,9 @@ layoutModule lmod@(L _ mod') = do
let tn = Text.pack $ moduleNameString $ unLoc n let tn = Text.pack $ moduleNameString $ unLoc n
(hasComments, es) <- case les of (hasComments, es) <- case les of
Nothing -> return (False, docEmpty) Nothing -> return (False, docEmpty)
Just llies@(L _ lies) -> do Just llies -> do
hasComments <- hasAnyCommentsBelow llies hasComments <- hasAnyCommentsBelow llies
return (hasComments, docWrapNode llies $ layoutIEList lies) return (hasComments, layoutLLIEs llies)
docLines docLines
$ docSeq $ docSeq
[ docWrapNode lmod $ docEmpty [ docWrapNode lmod $ docEmpty