Fix double-printing of comments on certain data-decls

ghc92
Lennart Spitzner 2023-04-14 14:36:41 +00:00
parent f13a82964a
commit 75d17b961c
2 changed files with 8 additions and 6 deletions

View File

@ -17,12 +17,13 @@ import Language.Haskell.Brittany.Internal.Components.BriDoc
layoutDataDecl layoutDataDecl
:: LTyClDecl GhcPs :: LTyClDecl GhcPs
-> EpAnn [AddEpAnn]
-> LIdP GhcPs -> LIdP GhcPs
-> LHsQTyVars GhcPs -> LHsQTyVars GhcPs
-> [LHsTypeArg GhcPs] -> [LHsTypeArg GhcPs]
-> HsDataDefn GhcPs -> HsDataDefn GhcPs
-> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered
layoutDataDecl ltycl name (HsQTvs _ bndrs) pats defn = case defn of layoutDataDecl ltycl declEpAnn name (HsQTvs _ bndrs) pats defn = case defn of
-- newtype MyType a b = MyType .. -- newtype MyType a b = MyType ..
HsDataDefn NoExtField NewType Nothing _ctype Nothing [cons] mDerivs -> HsDataDefn NoExtField NewType Nothing _ctype Nothing [cons] mDerivs ->
case cons of case cons of
@ -43,7 +44,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) pats defn = case defn of
-- , appSep tyVarLine -- , appSep tyVarLine
-- ] -- ]
rhsDoc <- return <$> createDetailsDoc consNameStr details rhsDoc <- return <$> createDetailsDoc consNameStr details
createDerivingPar mDerivs $ docSeq docHandleComms declEpAnn $ createDerivingPar mDerivs $ docSeq
[ appSep $ docLitS "newtype" [ appSep $ docLitS "newtype"
, appSep $ docLit nameStr , appSep $ docLit nameStr
, appSep tyVarLine , appSep tyVarLine
@ -66,7 +67,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) pats defn = case defn of
nameStr <- lrdrNameToTextAnn name nameStr <- lrdrNameToTextAnn name
tyVarLine <- return <$> createBndrDoc bndrs tyVarLine <- return <$> createBndrDoc bndrs
patDocs <- mapM shareDoc $ layoutHsTyPats pats patDocs <- mapM shareDoc $ layoutHsTyPats pats
createDerivingPar mDerivs $ docSeq docHandleComms declEpAnn $ createDerivingPar mDerivs $ docSeq
[ appSep $ docLitS "data" [ appSep $ docLitS "data"
, lhsContextDoc , lhsContextDoc
, appSep $ docLit nameStr , appSep $ docLit nameStr
@ -122,7 +123,7 @@ layoutDataDecl ltycl name (HsQTvs _ bndrs) pats defn = case defn of
] ]
(Nothing, Nothing) -> (Nothing, Nothing) ->
docSeq [docLitS "=", docSeparator, rhsDoc] docSeq [docLitS "=", docSeparator, rhsDoc]
createDerivingPar mDerivs $ docAlt docHandleComms declEpAnn $ createDerivingPar mDerivs $ docAlt
[ -- data D = forall a . Show a => D a [ -- data D = forall a . Show a => D a
docSeq docSeq
[ -- TOOD92 docNodeAnnKW ltycl (Just GHC.AnnData) $ [ -- TOOD92 docNodeAnnKW ltycl (Just GHC.AnnData) $

View File

@ -787,7 +787,7 @@ layoutTyCl ltycl@(L _loc tycl) = case tycl of
1 1
typeDoc typeDoc
DataDecl epAnn name tyVars _ dataDefn -> DataDecl epAnn name tyVars _ dataDefn ->
docHandleComms epAnn $ layoutDataDecl ltycl name tyVars [] dataDefn layoutDataDecl ltycl epAnn name tyVars [] dataDefn
_ -> briDocByExactNoComment ltycl _ -> briDocByExactNoComment ltycl
layoutTyVarBndr :: Bool -> ToBriDoc (HsTyVarBndr ()) layoutTyVarBndr :: Bool -> ToBriDoc (HsTyVarBndr ())
@ -945,8 +945,9 @@ layoutClsInst (L declLoc _) cid = do
layoutDataFamInstDecl ldfid@(L _ (DataFamInstDecl famEqn)) = layoutDataFamInstDecl ldfid@(L _ (DataFamInstDecl famEqn)) =
docHandleComms ldfid $ case famEqn of docHandleComms ldfid $ case famEqn of
FamEqn epAnn tycon bndrs pats Prefix rhs -> do FamEqn epAnn tycon bndrs pats Prefix rhs -> do
docHandleComms epAnn $ layoutDataDecl layoutDataDecl
(error "Unsupported form of DataFamInstDecl") (error "Unsupported form of DataFamInstDecl")
epAnn
tycon tycon
(case bndrs of (case bndrs of
HsOuterImplicit NoExtField -> HsQTvs NoExtField [] HsOuterImplicit NoExtField -> HsQTvs NoExtField []