diff --git a/src-unittests/IdentityTests.hs b/src-unittests/IdentityTests.hs index fa5bd82..5c509ec 100644 --- a/src-unittests/IdentityTests.hs +++ b/src-unittests/IdentityTests.hs @@ -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 $ diff --git a/src/Language/Haskell/Brittany/LayoutBasics.hs b/src/Language/Haskell/Brittany/LayoutBasics.hs index 1fa2b05..f142dd7 100644 --- a/src/Language/Haskell/Brittany/LayoutBasics.hs +++ b/src/Language/Haskell/Brittany/LayoutBasics.hs @@ -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 diff --git a/src/Language/Haskell/Brittany/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Layouters/Decl.hs index f69a4e7..59c3018 100644 --- a/src/Language/Haskell/Brittany/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Layouters/Decl.hs @@ -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