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 it "comment inline placement (temporary)" $ do
roundTripEqual $ roundTripEqual $
[text| [text|
func :: Int -> -- basic indentation amount func
Int -> -- currently used width in current line (after indent) :: Int -- basic indentation amount
-- used to accurately calc placing of the current-line -> Int -- currently used width in current line (after indent)
LayoutDesc -> Int -- used to accurately calc placing of the current-line
-> LayoutDesc
-> Int
|] |]
it "some indentation thingy" $ do it "some indentation thingy" $ do
roundTripEqual $ roundTripEqual $

View File

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

View File

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