Add comment-aware alternative filtering (type sig)
parent
55709c9b17
commit
46ad20e8f9
|
@ -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 $
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue