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

Improve module layouting in two aspects 

- IEThingWith in export list can now be single-line
- Now respect offset of the "module" keyword
  (retain empty lines after pragmas, for example)
pull/124/head
Lennart Spitzner 2018-03-12 16:29:47 +01:00
parent 20f9c009ee
commit 9531edb2a7
10 changed files with 131 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -625,6 +625,15 @@ module Main (module Main) where
#test export-with-things
module Main (Test(Test, a, b)) where
#test export-with-things-comment
-- comment1
module Main
( Test(Test, a, b)
, foo -- comment2
) -- comment3
where
#test export-with-empty-thing
module Main (Test()) where

62
src/Language/Haskell/Brittany/Internal.hs
View File

@ -16,7 +16,7 @@ where
#include "prelude.inc"
import qualified Language.Haskell.GHC.ExactPrint as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint.Types
import qualified Language.Haskell.GHC.ExactPrint.Types as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Parsers as ExactPrint.Parsers
import Data.Data
@ -133,7 +133,7 @@ parsePrintModule configRaw inputText = runExceptT $ do
-- can occur.
pPrintModule
:: Config
-> ExactPrint.Types.Anns
-> ExactPrint.Anns
-> GHC.ParsedSource
-> ([BrittanyError], TextL.Text)
pPrintModule conf anns parsedModule =
@ -169,7 +169,7 @@ pPrintModule conf anns parsedModule =
-- if it does not.
pPrintModuleAndCheck
:: Config
-> ExactPrint.Types.Anns
-> ExactPrint.Anns
-> GHC.ParsedSource
-> IO ([BrittanyError], TextL.Text)
pPrintModuleAndCheck conf anns parsedModule = do
@ -253,7 +253,7 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
post <- ppPreamble lmod
decls `forM_` \decl -> do
filteredAnns <- mAsk <&> \annMap ->
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey decl) annMap
Map.findWithDefault Map.empty (ExactPrint.mkAnnKey decl) annMap
traceIfDumpConf "bridoc annotations filtered/transformed"
_dconf_dump_annotations
@ -266,26 +266,26 @@ ppModule lmod@(L _loc _m@(HsModule _name _exports _ decls _ _)) = do
ppDecl decl
let finalComments = filter
( fst .> \case
ExactPrint.Types.AnnComment{} -> True
ExactPrint.AnnComment{} -> True
_ -> False
)
post
post `forM_` \case
(ExactPrint.Types.AnnComment (ExactPrint.Types.Comment cmStr _ _), l) -> do
(ExactPrint.AnnComment (ExactPrint.Comment cmStr _ _), l) -> do
ppmMoveToExactLoc l
mTell $ Text.Builder.fromString cmStr
(ExactPrint.Types.G AnnEofPos, (ExactPrint.Types.DP (eofX, eofY))) ->
(ExactPrint.G AnnEofPos, (ExactPrint.DP (eofZ, eofX))) ->
let
folder (acc, _) (kw, ExactPrint.Types.DP (x, y)) = case kw of
ExactPrint.Types.AnnComment cm
| GHC.RealSrcSpan span <- ExactPrint.Types.commentIdentifier cm
-> ( acc + x + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
, y + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
folder (acc, _) (kw, ExactPrint.DP (y, x)) = case kw of
ExactPrint.AnnComment cm
| GHC.RealSrcSpan span <- ExactPrint.commentIdentifier cm
-> ( acc + y + GHC.srcSpanEndLine span - GHC.srcSpanStartLine span
, x + GHC.srcSpanEndCol span - GHC.srcSpanStartCol span
)
_ -> (acc + x, y)
(cmX, cmY) = foldl' folder (0, 0) finalComments
_ -> (acc + y, x)
(cmY, cmX) = foldl' folder (0, 0) finalComments
in
ppmMoveToExactLoc $ ExactPrint.Types.DP (eofX - cmX, eofY - cmY)
ppmMoveToExactLoc $ ExactPrint.DP (eofZ - cmY, eofX - cmX)
_ -> return ()
withTransformedAnns :: Data ast => ast -> PPMLocal () -> PPMLocal ()
@ -323,23 +323,23 @@ ppDecl d@(L loc decl) = case decl of
-- Prints the information associated with the module annotation
-- This includes the imports
ppPreamble :: GenLocated SrcSpan (HsModule RdrName)
-> PPM [(ExactPrint.Types.KeywordId, ExactPrint.Types.DeltaPos)]
-> PPM [(ExactPrint.KeywordId, ExactPrint.DeltaPos)]
ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
filteredAnns <- mAsk <&> \annMap ->
Map.findWithDefault Map.empty (ExactPrint.Types.mkAnnKey lmod) annMap
Map.findWithDefault Map.empty (ExactPrint.mkAnnKey lmod) annMap
-- Since ghc-exactprint adds annotations following (implicit)
-- modules to both HsModule and the elements in the module
-- this can cause duplication of comments. So strip
-- attached annotations that come after the module's where
-- from the module node
let (filteredAnns', post) =
case (ExactPrint.Types.mkAnnKey lmod) `Map.lookup` filteredAnns of
case (ExactPrint.mkAnnKey lmod) `Map.lookup` filteredAnns of
Nothing -> (filteredAnns, [])
Just mAnn ->
let modAnnsDp = ExactPrint.Types.annsDP mAnn
isWhere (ExactPrint.Types.G AnnWhere) = True
let modAnnsDp = ExactPrint.annsDP mAnn
isWhere (ExactPrint.G AnnWhere) = True
isWhere _ = False
isEof (ExactPrint.Types.G AnnEofPos) = True
isEof (ExactPrint.G AnnEofPos) = True
isEof _ = False
whereInd = List.findIndex (isWhere . fst) modAnnsDp
eofInd = List.findIndex (isEof . fst) modAnnsDp
@ -348,8 +348,22 @@ ppPreamble lmod@(L _ (HsModule _ _ _ _ _ _)) = do
(Just i , Nothing) -> List.splitAt (i + 1) modAnnsDp
(Nothing, Just _i) -> ([], modAnnsDp)
(Just i , Just j ) -> List.splitAt (min (i + 1) j) modAnnsDp
mAnn' = mAnn { ExactPrint.Types.annsDP = pre }
filteredAnns'' = Map.insert (ExactPrint.Types.mkAnnKey lmod) mAnn' filteredAnns
findInitialCommentSize = \case
((ExactPrint.AnnComment cm, ExactPrint.DP (y, _)):rest) ->
let GHC.RealSrcSpan span = ExactPrint.commentIdentifier cm
in y
+ GHC.srcSpanEndLine span
- GHC.srcSpanStartLine span
+ findInitialCommentSize rest
_ -> 0
initialCommentSize = findInitialCommentSize pre
fixAbsoluteModuleDP = \case
(g@(ExactPrint.G AnnModule), ExactPrint.DP (y, x)) ->
(g, ExactPrint.DP (y - initialCommentSize, x))
x -> x
pre' = map fixAbsoluteModuleDP pre
mAnn' = mAnn { ExactPrint.annsDP = pre' }
filteredAnns'' = Map.insert (ExactPrint.mkAnnKey lmod) mAnn' filteredAnns
in (filteredAnns'', post')
in do
traceIfDumpConf "bridoc annotations filtered/transformed"
@ -415,7 +429,7 @@ layoutBriDoc briDoc = do
-- simpl <- mGet <&> transformToSimple
-- return simpl
anns :: ExactPrint.Types.Anns <- mAsk
anns :: ExactPrint.Anns <- mAsk
let state = LayoutState
{ _lstate_baseYs = [0]

19
src/Language/Haskell/Brittany/Internal/Backend.hs
View File

@ -250,6 +250,23 @@ layoutBriDocM = \case
-- layoutMoveToIndentCol y
layoutWriteAppendMultiline $ Text.pack $ comment
-- mModify $ \s -> s { _lstate_curYOrAddNewline = Right 0 }
BDMoveToKWDP annKey keyword bd -> do
mDP <- do
state <- mGet
let m = _lstate_comments state
let mAnn = ExactPrint.annsDP <$> Map.lookup annKey m
let relevant = [ dp
| Just ann <- [mAnn]
, (ExactPrint.Types.G kw1, dp) <- ann
, keyword == kw1
]
pure $ case relevant of
[] -> Nothing
(dp:_) -> Just dp
case mDP of
Nothing -> pure ()
Just (ExactPrint.Types.DP (y, x)) -> layoutMoveToCommentPos y x
layoutBriDocM bd
BDNonBottomSpacing bd -> layoutBriDocM bd
BDSetParSpacing bd -> layoutBriDocM bd
BDForceParSpacing bd -> layoutBriDocM bd
@ -282,6 +299,7 @@ briDocLineLength briDoc = flip StateS.evalState False $ rec briDoc
BDAnnotationPrior _ bd -> rec bd
BDAnnotationKW _ _ bd -> rec bd
BDAnnotationRest _ bd -> rec bd
BDMoveToKWDP _ _ bd -> rec bd
BDLines ls@(_:_) -> do
x <- StateS.get
return $ maximum $ ls <&> \l -> StateS.evalState (rec l) x
@ -317,6 +335,7 @@ briDocIsMultiLine briDoc = rec briDoc
BDAnnotationPrior _ bd -> rec bd
BDAnnotationKW _ _ bd -> rec bd
BDAnnotationRest _ bd -> rec bd
BDMoveToKWDP _ _ bd -> rec bd
BDLines (_:_:_) -> True
BDLines [_ ] -> False
BDLines [] -> error "briDocIsMultiLine BDLines []"

18
src/Language/Haskell/Brittany/Internal/LayouterBasics.hs
View File

@ -16,6 +16,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docSeq
, docPar
, docNodeAnnKW
, docNodeMoveToKWDP
, docWrapNode
, docWrapNodePrior
, docWrapNodeRest
@ -29,6 +30,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docAnnotationPrior
, docAnnotationKW
, docAnnotationRest
, docMoveToKWDP
, docNonBottomSpacing
, docSetParSpacing
, docForceParSpacing
@ -441,6 +443,13 @@ docAnnotationKW
-> ToBriDocM BriDocNumbered
docAnnotationKW annKey kw bdm = allocateNode . BDFAnnotationKW annKey kw =<< bdm
docMoveToKWDP
:: AnnKey
-> AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docMoveToKWDP annKey kw bdm = allocateNode . BDFMoveToKWDP annKey kw =<< bdm
docAnnotationRest
:: AnnKey -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
docAnnotationRest annKey bdm = allocateNode . BDFAnnotationRest annKey =<< bdm
@ -481,6 +490,15 @@ docNodeAnnKW
docNodeAnnKW ast kw bdm =
docAnnotationKW (ExactPrint.Types.mkAnnKey ast) kw bdm
docNodeMoveToKWDP
:: Data.Data.Data ast
=> Located ast
-> AnnKeywordId
-> ToBriDocM BriDocNumbered
-> ToBriDocM BriDocNumbered
docNodeMoveToKWDP ast kw bdm =
docMoveToKWDP (ExactPrint.Types.mkAnnKey ast) kw bdm
class DocWrapable a where
docWrapNode :: ( Data.Data.Data ast)
=> Located ast

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

@ -117,8 +117,8 @@ layoutAnnAndSepLLIEs llies@(L _ lies) = do
-- () -- no comments
-- ( -- a comment
-- )
layoutLLIEs :: Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs llies = do
layoutLLIEs :: Bool -> Located [LIE RdrName] -> ToBriDocM BriDocNumbered
layoutLLIEs enableSingleline llies = do
ieDs <- layoutAnnAndSepLLIEs llies
hasComments <- hasAnyCommentsBelow llies
case ieDs of
@ -130,7 +130,7 @@ layoutLLIEs llies = do
)
]
(ieDsH:ieDsT) -> docAltFilter
[ ( not hasComments
[ ( not hasComments && enableSingleline
, docSeq
$ [docLit (Text.pack "(")]
++ (docForceSingleline <$> ieDs)

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

@ -84,7 +84,7 @@ layoutImport limportD@(L _ importD) = docWrapNode limportD $ case importD of
Just (_, llies) -> do
hasComments <- hasAnyCommentsBelow llies
if compact
then docSeq [hidDoc, layoutLLIEs llies]
then docSeq [hidDoc, layoutLLIEs True llies]
else do
ieDs <- layoutAnnAndSepLLIEs llies
docWrapNodeRest llies $ case ieDs of

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

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

4
src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
View File

@ -301,6 +301,8 @@ transformAlts briDoc =
reWrap . BDFAnnotationRest annKey <$> rec bd
BDFAnnotationKW annKey kw bd ->
reWrap . BDFAnnotationKW annKey kw <$> rec bd
BDFMoveToKWDP annKey kw bd ->
reWrap . BDFMoveToKWDP annKey kw <$> rec bd
BDFLines [] -> return $ reWrap BDFEmpty -- evil transformation. or harmless.
BDFLines (l:lr) -> do
ind <- _acp_indent <$> mGet
@ -460,6 +462,7 @@ getSpacing !bridoc = rec bridoc
BDFAnnotationPrior _annKey bd -> rec bd
BDFAnnotationKW _annKey _kw bd -> rec bd
BDFAnnotationRest _annKey bd -> rec bd
BDFMoveToKWDP _annKey _kw bd -> rec bd
BDFLines [] -> return
$ LineModeValid
$ VerticalSpacing 0 VerticalSpacingParNone False
@ -705,6 +708,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
BDFAnnotationPrior _annKey bd -> rec bd
BDFAnnotationKW _annKey _kw bd -> rec bd
BDFAnnotationRest _annKey bd -> rec bd
BDFMoveToKWDP _annKey _kw bd -> rec bd
BDFLines [] -> return $ [VerticalSpacing 0 VerticalSpacingParNone False]
BDFLines ls@(_:_) -> do
-- we simply assume that lines is only used "properly", i.e. in

1
src/Language/Haskell/Brittany/Internal/Transformations/Columns.hs
View File

@ -128,6 +128,7 @@ transformSimplifyColumns = Uniplate.rewrite $ \case
BDAnnotationPrior{} -> Nothing
BDAnnotationKW{} -> Nothing
BDAnnotationRest{} -> Nothing
BDMoveToKWDP{} -> Nothing
BDEnsureIndent{} -> Nothing
BDSetParSpacing{} -> Nothing
BDForceParSpacing{} -> Nothing

5
src/Language/Haskell/Brittany/Internal/Types.hs
View File

@ -233,6 +233,7 @@ data BriDoc
| BDAnnotationPrior AnnKey BriDoc
| BDAnnotationKW AnnKey (Maybe AnnKeywordId) BriDoc
| BDAnnotationRest AnnKey BriDoc
| BDMoveToKWDP AnnKey AnnKeywordId BriDoc
| BDLines [BriDoc]
| BDEnsureIndent BrIndent BriDoc
-- the following constructors are only relevant for the alt transformation
@ -278,6 +279,7 @@ data BriDocF f
| BDFAnnotationPrior AnnKey (f (BriDocF f))
| BDFAnnotationKW AnnKey (Maybe AnnKeywordId) (f (BriDocF f))
| BDFAnnotationRest AnnKey (f (BriDocF f))
| BDFMoveToKWDP AnnKey AnnKeywordId (f (BriDocF f))
| BDFLines [(f (BriDocF f))]
| BDFEnsureIndent BrIndent (f (BriDocF f))
| BDFForceMultiline (f (BriDocF f))
@ -311,6 +313,7 @@ instance Uniplate.Uniplate BriDoc where
uniplate (BDAnnotationPrior annKey bd) = plate BDAnnotationPrior |- annKey |* bd
uniplate (BDAnnotationKW annKey kw bd) = plate BDAnnotationKW |- annKey |- kw |* bd
uniplate (BDAnnotationRest annKey bd) = plate BDAnnotationRest |- annKey |* bd
uniplate (BDMoveToKWDP annKey kw bd) = plate BDMoveToKWDP |- annKey |- kw |* bd
uniplate (BDLines lines) = plate BDLines ||* lines
uniplate (BDEnsureIndent ind bd) = plate BDEnsureIndent |- ind |* bd
uniplate (BDForceMultiline bd) = plate BDForceMultiline |* bd
@ -342,6 +345,7 @@ unwrapBriDocNumbered tpl = case snd tpl of
BDFAnnotationPrior annKey bd -> BDAnnotationPrior annKey $ rec bd
BDFAnnotationKW annKey kw bd -> BDAnnotationKW annKey kw $ rec bd
BDFAnnotationRest annKey bd -> BDAnnotationRest annKey $ rec bd
BDFMoveToKWDP annKey kw bd -> BDMoveToKWDP annKey kw $ rec bd
BDFLines lines -> BDLines $ rec <$> lines
BDFEnsureIndent ind bd -> BDEnsureIndent ind $ rec bd
BDFForceMultiline bd -> BDForceMultiline $ rec bd
@ -377,6 +381,7 @@ briDocSeqSpine = \case
BDAnnotationPrior _annKey bd -> briDocSeqSpine bd
BDAnnotationKW _annKey _kw bd -> briDocSeqSpine bd
BDAnnotationRest _annKey bd -> briDocSeqSpine bd
BDMoveToKWDP _annKey _kw bd -> briDocSeqSpine bd
BDLines lines -> foldl' (\(!()) -> briDocSeqSpine) () lines
BDEnsureIndent _ind bd -> briDocSeqSpine bd
BDForceMultiline bd -> briDocSeqSpine bd