Add comment-aware alternative filtering (type sig)

pull/3/head
Lennart Spitzner 2016-08-11 23:04:55 +02:00
parent 55709c9b17
commit 46ad20e8f9
3 changed files with 28 additions and 14 deletions

View File

@ -596,10 +596,12 @@ regressionTests = do
it "comment inline placement (temporary)" $ do
roundTripEqual $
[text|
func :: Int -> -- basic indentation amount
Int -> -- currently used width in current line (after indent)
-- used to accurately calc placing of the current-line
LayoutDesc -> Int
func
:: Int -- basic indentation amount
-> Int -- currently used width in current line (after indent)
-- used to accurately calc placing of the current-line
-> LayoutDesc
-> Int
|]
it "some indentation thingy" $ do
roundTripEqual $

View File

@ -76,6 +76,7 @@ module Language.Haskell.Brittany.LayoutBasics
, briDocMToPPM
, allocateNode
, docSharedWrapper
, hasAnyCommentsBelow
)
where
@ -698,15 +699,15 @@ layoutWritePostComments ast = do
layoutWriteAppendMultiline $ Text.pack $ comment
layoutIndentRestorePostComment
:: ( Monad m
, MonadMultiState LayoutState m
:: ( MonadMultiState LayoutState m
, MonadMultiWriter Text.Builder.Builder m
, MonadMultiWriter (Seq String) m
)
=> m ()
layoutIndentRestorePostComment = do
mCommentCol <- _lstate_commentCol <$> mGet
eCurYAddNL <- _lstate_curYOrAddNewline <$> mGet
state <- mGet
let mCommentCol = _lstate_commentCol state
let eCurYAddNL = _lstate_curYOrAddNewline state
#if INSERTTRACES
tellDebugMessShow ("layoutIndentRestorePostComment", mCommentCol)
#endif
@ -714,7 +715,7 @@ layoutIndentRestorePostComment = do
case (mCommentCol, eCurYAddNL) of
(Just commentCol, Left{}) -> do
layoutWriteEnsureNewlineBlock
layoutWriteEnsureAbsoluteN commentCol
layoutWriteEnsureAbsoluteN $ commentCol + fromMaybe 0 (_lstate_addSepSpace state)
_ -> return ()
-- layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
@ -770,6 +771,14 @@ filterAnns :: Data.Data.Data ast
filterAnns ast anns =
Map.filterWithKey (\k _ -> k `Set.member` foldedAnnKeys ast) anns
hasAnyCommentsBelow :: Data ast => GHC.Located ast -> ToBriDocM Bool
hasAnyCommentsBelow ast@(L l _) = do
anns <- filterAnns ast <$> mAsk
return $ List.any (\(c, _) -> ExactPrint.commentIdentifier c > l)
$ (=<<) extractAllComments
$ Map.elems
$ anns
-- new BriDoc stuff
allocateNode :: MonadMultiState NodeAllocIndex m

View File

@ -37,18 +37,21 @@ import Bag ( mapBagM )
layoutSig :: ToBriDoc Sig
layoutSig lsig@(L _loc sig) = docWrapNode lsig $ case sig of
TypeSig names (HsIB _ (HsWC _ _ typ)) -> do
layoutSig lsig@(L _loc sig) = case sig of
TypeSig names (HsIB _ (HsWC _ _ typ)) -> docWrapNode lsig $ do
nameStrs <- names `forM` lrdrNameToTextAnn
let nameStr = Text.intercalate (Text.pack ", ") $ nameStrs
typeDoc <- docSharedWrapper layoutType typ
docAlt
hasComments <- hasAnyCommentsBelow lsig
docAlt $
[ docSeq
[ appSep $ docWrapNodeRest lsig $ docLit nameStr
, appSep $ docLit $ Text.pack "::"
, docForceSingleline typeDoc
]
, docAddBaseY BrIndentRegular
| not hasComments
] ++
[ docAddBaseY BrIndentRegular
$ docPar
(docWrapNodeRest lsig $ docLit nameStr)
( docCols ColTyOpPrefix
@ -57,7 +60,7 @@ layoutSig lsig@(L _loc sig) = docWrapNode lsig $ case sig of
]
)
]
_ -> briDocByExact lsig -- TODO: should not be necessary
_ -> briDocByExactNoComment lsig -- TODO
layoutGuardLStmt :: ToBriDoc' (Stmt RdrName (LHsExpr RdrName))
layoutGuardLStmt lgstmt@(L _ stmtLR) = docWrapNode lgstmt $ case stmtLR of