From 162b6e6bfda6fc64b6f5fc28345bca41fab383d7 Mon Sep 17 00:00:00 2001 From: sniperrifle2004 Date: Tue, 19 Dec 2017 16:33:13 +0100 Subject: [PATCH] Also fix export comments Also refactored a little to improve reuse of the docWrapNode logic --- src-literatetests/10-tests.blt | 11 +++ src-literatetests/tests-context-free.blt | 10 +++ .../Haskell/Brittany/Internal/Layouters/IE.hs | 57 +++++++++----- .../Brittany/Internal/Layouters/Import.hs | 75 ++++++++----------- .../Brittany/Internal/Layouters/Module.hs | 4 +- 5 files changed, 94 insertions(+), 63 deletions(-) diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index 6b49e57..e560296 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -583,6 +583,7 @@ where #test exports-with-comments module Main ( main + -- main , test1 , test2 -- Test 3 @@ -590,6 +591,7 @@ module Main , test4 -- Test 5 , test5 + -- Test 6 ) where @@ -732,6 +734,14 @@ import Test ( abc -- 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 {-# LANGUAGE BangPatterns #-} @@ -751,6 +761,7 @@ module Test , test8 , test9 , test10 + -- Test 10 ) where diff --git a/src-literatetests/tests-context-free.blt b/src-literatetests/tests-context-free.blt index 1bc25ac..8be4666 100644 --- a/src-literatetests/tests-context-free.blt +++ b/src-literatetests/tests-context-free.blt @@ -631,6 +631,7 @@ where #test exports-with-comments module Main ( main + -- main , test1 , test2 -- Test 3 @@ -638,6 +639,7 @@ module Main , test4 -- Test 5 , test5 + -- Test 6 ) where @@ -767,6 +769,14 @@ import Test ( abc -- 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 {-# LANGUAGE BangPatterns #-} diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs index 9876f01..bf87b6d 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/IE.hs @@ -1,6 +1,7 @@ module Language.Haskell.Brittany.Internal.Layouters.IE ( layoutIE - , layoutIEList + , layoutLLIEs + , layoutAnnAndSepLLIEs ) where @@ -61,20 +62,42 @@ layoutIE lie@(L _ ie) = docWrapNode lie $ case ie of _ -> docEmpty where ien = docLit =<< lrdrNameToTextAnn (ieName <$> lie) -layoutIEList :: [LIE RdrName] -> ToBriDocM BriDocNumbered -layoutIEList lies = do - ies <- mapM (docSharedWrapper layoutIE) lies - case ies of - [] -> docLit $ Text.pack "()" - xs@(x1:xr) -> docAlt - [ docSeq - [ docLit $ Text.pack "(" - , docSeq $ List.intersperse docCommaSep xs - , docLit $ Text.pack ")" +-- 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 +-- This configuration allows both vertical and horizontal +-- handling of the resulting list. Adding parens is +-- left to the caller since that is context sensitive +layoutAnnAndSepLLIEs :: (Located [LIE RdrName]) -> ToBriDocM [ToBriDocM BriDocNumbered] +layoutAnnAndSepLLIEs llies@(L _ lies) = do + 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] - ) - ] diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs index e2ba394..cc4172f 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Import.hs @@ -50,9 +50,9 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of modNameT = Text.pack $ moduleNameString modName pkgNameT = Text.pack . prepPkg . sl_st <$> pkg asT = Text.pack . moduleNameString . prepModName <$> as - (hiding, mlies) = case mllies of - Just (h, L _ lies') -> (h, Just lies') - Nothing -> (False, Nothing) + hiding = case mllies of + Just (h, _) -> h + Nothing -> False minQLength = length "import qualified " qLengthReal = let qualifiedPart = if q then length "qualified " else 0 @@ -77,49 +77,36 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of hidDoc = if hiding then appSep $ docLit $ Text.pack "hiding" else docEmpty importHead = docSeq [importQualifiers, modNameD] - Just lies = mlies - Just (_, llies) = mllies - (ieH:ieT) = map layoutIE lies - 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 + bindingsH = docParenLSep + bindingsT = [docSeq [docSeparator, docParenR]] + bindingsD = case mllies of Nothing -> docSeq [docEmpty] - -- ..[hiding].( ) - Just [] -> do + Just (_, llies) -> do + ieDs <- layoutAnnAndSepLLIEs llies hasComments <- hasAnyCommentsBelow llies - if hasComments - then - docWrapNodeRest llies - $ docPar - (docSeq [hidDoc, docParenLSep, docWrapNode llies docEmpty]) - $ docLines [docParenR] - else - docWrapNodeRest llies $ docSeq [hidDoc, docParenLSep, docParenR] - -- ..[hiding].( b ) - Just [_] -> do - hasComments <- hasAnyCommentsBelow llies - if hasComments - then - docWrapNodeRest llies $ docPar (docSeq [hidDoc, docWrapNode llies $ bindingsH]) $ docLines - bindingsT - else - docWrapNodeRest llies $ docSeq $ hidDoc : bindings - -- ..[hiding].( b - -- , b' - -- ) - Just _ -> - docWrapNodeRest llies $ docPar (docSeq [hidDoc, docSetBaseY $ bindingsH]) - $ docLines bindingsT + case ieDs of + -- ..[hiding].( ) + [] -> do + if hasComments + then + docWrapNodeRest llies $ docPar (docSeq [hidDoc, bindingsH, docWrapNode llies docEmpty]) $ docLines + bindingsT + else + docWrapNodeRest llies $ docSeq $ hidDoc : bindingsH : bindingsT + -- ..[hiding].( b ) + [ieD] -> do + if hasComments + then + docWrapNodeRest llies $ docPar (docSeq [hidDoc, bindingsH, ieD ]) $ docLines $ + bindingsT + else + docWrapNodeRest llies $ docSeq $ hidDoc : bindingsH : ieD : bindingsT + -- ..[hiding].( b + -- , b' + -- ) + (ieD:ieDs') -> do + docWrapNodeRest llies $ docPar (docSeq [hidDoc, docSetBaseY $ docSeq [bindingsH, ieD]]) + $ docLines $ ieDs' ++ bindingsT bindingLine = docEnsureIndent (BrIndentSpecial (importCol - bindingCost)) bindingsD case asT of diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs index d7ce6ea..509b24a 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Module.hs @@ -32,9 +32,9 @@ layoutModule lmod@(L _ mod') = do let tn = Text.pack $ moduleNameString $ unLoc n (hasComments, es) <- case les of Nothing -> return (False, docEmpty) - Just llies@(L _ lies) -> do + Just llies -> do hasComments <- hasAnyCommentsBelow llies - return (hasComments, docWrapNode llies $ layoutIEList lies) + return (hasComments, layoutLLIEs llies) docLines $ docSeq [ docWrapNode lmod $ docEmpty