Fix type synonym comments

pull/189/head
Rupert Horlick 2018-10-19 15:32:37 -04:00
parent b249c10054
commit e7d8b5f1ab
No known key found for this signature in database
GPG Key ID: D15A1B9A51513E0A
3 changed files with 45 additions and 34 deletions

View File

@ -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

View File

@ -63,6 +63,7 @@ module Language.Haskell.Brittany.Internal.LayouterBasics
, docSharedWrapper
, hasAnyCommentsBelow
, hasAnyCommentsConnected
, hasAnyCommentsPrior
, hasAnnKeywordComment
, hasAnnKeyword
)
@ -297,11 +298,14 @@ 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
hasAnnKeywordComment ast annKeyword = astAnn ast <&> \case
Nothing -> False
Just ann -> any hasK (extractAllComments ann)
where hasK = (== Just annKeyword) . ExactPrint.Types.commentOrigin . fst
@ -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
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

View File

@ -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
let needsParens = not $ null rest || hasOwnParens
parenWrapper . docSeq
docSeq
$ [ appSep $ docLit $ Text.pack "type"
, appSep
. docSeq
@ -672,17 +672,20 @@ 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
hasComments <- hasAnyCommentsConnected typ
docAlt
[ docSeq [lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
, docAddBaseY BrIndentRegular $ docPar
$ [ docSeq
[lhs, appSep $ docLit $ Text.pack "=", docForceSingleline typeDoc]
| not hasComments
]
++ [ docAddBaseY BrIndentRegular $ docPar
lhs
(docCols
ColTyOpPrefix
[docLit $ Text.pack "= ", docAddBaseY (BrIndentSpecial 2) typeDoc]
)
(docCols ColTyOpPrefix [appSep $ docLit $ Text.pack "=", typeDoc])
]
layoutTyVarBndr :: ToBriDoc HsTyVarBndr