Fix type synonym comments
parent
b249c10054
commit
e7d8b5f1ab
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue