diff --git a/src-literatetests/10-tests.blt b/src-literatetests/10-tests.blt index f2b02d8..83dfc61 100644 --- a/src-literatetests/10-tests.blt +++ b/src-literatetests/10-tests.blt @@ -983,7 +983,6 @@ type a :+: b = (a, b) type (a `Foo` b) c = (a, b, c) #test synonym-comments -#pending type Foo a -- fancy type comment = -- strange comment diff --git a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs index 9f6366e..458f7ed 100644 --- a/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs +++ b/src/Language/Haskell/Brittany/Internal/LayouterBasics.hs @@ -63,6 +63,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics , docSharedWrapper , hasAnyCommentsBelow , hasAnyCommentsConnected + , hasAnyCommentsPrior , hasAnnKeywordComment , hasAnnKeyword ) @@ -297,13 +298,16 @@ hasAnyCommentsConnected ast = do $ Map.elems $ anns +hasAnyCommentsPrior :: Data ast => GHC.Located ast -> ToBriDocM Bool +hasAnyCommentsPrior ast = astAnn ast <&> \case + Nothing -> False + Just (ExactPrint.Types.Ann _ priors _ _ _ _) -> not $ null priors + hasAnnKeywordComment :: Data ast => GHC.Located ast -> AnnKeywordId -> ToBriDocM Bool -hasAnnKeywordComment ast annKeyword = do - anns <- mAsk - pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of - Nothing -> False - Just ann -> any hasK (extractAllComments ann) +hasAnnKeywordComment ast annKeyword = astAnn ast <&> \case + Nothing -> False + Just ann -> any hasK (extractAllComments ann) where hasK = (== Just annKeyword) . ExactPrint.Types.commentOrigin . fst hasAnnKeyword @@ -311,13 +315,18 @@ hasAnnKeyword => Located a -> AnnKeywordId -> m Bool -hasAnnKeyword ast annKeyword = do - anns <- mAsk - let hasK (ExactPrint.Types.G x, _) = x == annKeyword - hasK _ = False - pure $ case Map.lookup (ExactPrint.Types.mkAnnKey ast) anns of - Nothing -> False - Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks +hasAnnKeyword ast annKeyword = astAnn ast <&> \case + Nothing -> False + Just (ExactPrint.Types.Ann _ _ _ aks _ _) -> any hasK aks + where + hasK (ExactPrint.Types.G x, _) = x == annKeyword + hasK _ = False + +astAnn + :: (Data ast, MonadMultiReader (Map AnnKey Annotation) m) + => GHC.Located ast + -> m (Maybe Annotation) +astAnn ast = Map.lookup (ExactPrint.Types.mkAnnKey ast) <$> mAsk -- new BriDoc stuff diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index 4576e48..7f37282 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -633,12 +633,13 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of Just (c, _) -> not (c == '(' || isUpper c) isInfix <- (isInfixTypeOp ||) <$> hasAnnKeyword name AnnBackquote #endif - hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP - let parenWrapper = if hasTrailingParen - then appSep . docWrapNodeRest ltycl - else id + -- hasTrailingParen <- hasAnnKeywordComment ltycl AnnCloseP + -- let parenWrapper = if hasTrailingParen + -- then appSep . docWrapNodeRest ltycl + -- else id + let wrapNodeRest = docWrapNodeRest ltycl docWrapNodePrior ltycl - $ layoutSynDecl isInfix parenWrapper name (hsq_explicit vars) typ + $ layoutSynDecl isInfix wrapNodeRest name (hsq_explicit vars) typ _ -> briDocByExactNoComment ltycl layoutSynDecl @@ -648,17 +649,16 @@ layoutSynDecl -> [LHsTyVarBndr GhcPs] -> LHsType GhcPs -> ToBriDocM BriDocNumbered -layoutSynDecl isInfix parenWrapper name vars typ = do +layoutSynDecl isInfix wrapNodeRest name vars typ = do nameStr <- lrdrNameToTextAnn name let - lhs = if isInfix + lhs = appSep . wrapNodeRest $ if isInfix then do - let - (a : b : rest) = vars + let (a : b : rest) = vars hasOwnParens <- hasAnnKeywordComment a AnnOpenP - -- This isn't quite right, but does give syntactically valid results + -- This isn't quite right, but does give syntactically valid results let needsParens = not $ null rest || hasOwnParens - parenWrapper . docSeq + docSeq $ [ appSep $ docLit $ Text.pack "type" , appSep . docSeq @@ -672,18 +672,21 @@ layoutSynDecl isInfix parenWrapper name vars typ = do ++ fmap (appSep . layoutTyVarBndr) rest else docSeq - $ [appSep $ docLit $ Text.pack "type", appSep $ docLit nameStr] + $ [ appSep $ docLit $ Text.pack "type" + , appSep $ docWrapNode name $ docLit nameStr + ] ++ fmap (appSep . layoutTyVarBndr) vars - typeDoc <- docSharedWrapper layoutType typ + typeDoc <- docSharedWrapper layoutType typ + hasComments <- hasAnyCommentsConnected typ docAlt - [ docSeq [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc] - , docAddBaseY BrIndentRegular $ docPar - lhs - (docCols - ColTyOpPrefix - [docLit $ Text.pack "= ", docAddBaseY (BrIndentSpecial 2) typeDoc] - ) - ] + $ [ docSeq + [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc] + | not hasComments + ] + ++ [ docAddBaseY BrIndentRegular $ docPar + lhs + (docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc]) + ] layoutTyVarBndr :: ToBriDoc HsTyVarBndr layoutTyVarBndr lbndr@(L _ bndr) = do