From df2ee177b29bebc06700e21cc5d8778037f659ff Mon Sep 17 00:00:00 2001 From: Lennart Spitzner Date: Sun, 23 Feb 2020 23:09:03 +0100 Subject: [PATCH] Fix comments in instance/type instances (#282) --- src-literatetests/15-regressions.blt | 8 +++ .../Brittany/Internal/Layouters/Decl.hs | 59 +++++++++---------- 2 files changed, 37 insertions(+), 30 deletions(-) diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt index e4c1b7c..a6a0274 100644 --- a/src-literatetests/15-regressions.blt +++ b/src-literatetests/15-regressions.blt @@ -869,3 +869,11 @@ createRedirectedProcess processConfig = do , std_err = CreatePipe } foo + +#test issue 282 + +instance HasDependencies SomeDataModel where + -- N.B. Here is a bunch of explanatory context about the relationship + -- between these data models or whatever. + type Dependencies SomeDataModel + = (SomeOtherDataModelId, SomeOtherOtherDataModelId) diff --git a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs index e6466ac..13d0853 100644 --- a/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs +++ b/src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs @@ -72,7 +72,7 @@ layoutDecl d@(L loc decl) = case decl of Right n -> return n TyClD _ tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) InstD _ (TyFamInstD _ tfid) -> - withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid) + withTransformedAnns d $ layoutTyFamInstDecl False d tfid InstD _ (ClsInstD _ inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) _ -> briDocByExactNoComment d @@ -84,7 +84,7 @@ layoutDecl d@(L loc decl) = case decl of Right n -> return n TyClD tycl -> withTransformedAnns d $ layoutTyCl (L loc tycl) InstD (TyFamInstD tfid) -> - withTransformedAnns d $ layoutTyFamInstDecl False (L loc tfid) + withTransformedAnns d $ layoutTyFamInstDecl False d tfid InstD (ClsInstD inst) -> withTransformedAnns d $ layoutClsInst (L loc inst) _ -> briDocByExactNoComment d #endif @@ -941,39 +941,39 @@ layoutTyVarBndr needsSep lbndr@(L _ bndr) = do -layoutTyFamInstDecl :: Bool -> ToBriDoc TyFamInstDecl -layoutTyFamInstDecl inClass (L loc tfid) = do +layoutTyFamInstDecl + :: Data.Data.Data a + => Bool + -> Located a + -> TyFamInstDecl GhcPs + -> ToBriDocM BriDocNumbered +layoutTyFamInstDecl inClass outerNode tfid = do let #if MIN_VERSION_ghc(8,8,0) - linst = L loc (TyFamInstD NoExt tfid) - feqn@(FamEqn _ name bndrsMay pats _fixity typ) = hsib_body $ tfid_eqn tfid + FamEqn _ name bndrsMay pats _fixity typ = hsib_body $ tfid_eqn tfid -- bndrsMay isJust e.g. with -- type instance forall a . MyType (Maybe a) = Either () a - lfeqn = L loc feqn + innerNode = outerNode #elif MIN_VERSION_ghc(8,6,0) - linst = L loc (TyFamInstD NoExt tfid) - feqn@(FamEqn _ name pats _fixity typ) = hsib_body $ tfid_eqn tfid + FamEqn _ name pats _fixity typ = hsib_body $ tfid_eqn tfid bndrsMay = Nothing - lfeqn = L loc feqn + innerNode = outerNode #elif MIN_VERSION_ghc(8,4,0) - linst = L loc (TyFamInstD tfid) - feqn@(FamEqn name pats _fixity typ) = hsib_body $ tfid_eqn tfid + FamEqn name pats _fixity typ = hsib_body $ tfid_eqn tfid bndrsMay = Nothing - lfeqn = L loc feqn + innerNode = outerNode #elif MIN_VERSION_ghc(8,2,0) - linst = L loc (TyFamInstD tfid) - lfeqn@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid + innerNode@(L _ (TyFamEqn name boundPats _fixity typ)) = tfid_eqn tfid bndrsMay = Nothing pats = hsib_body boundPats #else - linst = L loc (TyFamInstD tfid) - lfeqn@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid + innerNode@(L _ (TyFamEqn name boundPats typ)) = tfid_eqn tfid bndrsMay = Nothing pats = hsib_body boundPats #endif - docWrapNodePrior linst $ do + docWrapNodePrior outerNode $ do nameStr <- lrdrNameToTextAnn name - needsParens <- hasAnnKeyword lfeqn AnnOpenP + needsParens <- hasAnnKeyword outerNode AnnOpenP let instanceDoc = if inClass then docLit $ Text.pack "type" @@ -987,9 +987,7 @@ layoutTyFamInstDecl inClass (L loc tfid) = do ++ processTyVarBndrsSingleline bndrDocs ) lhs = - docWrapNode lfeqn - . appSep - . docWrapNodeRest linst + docWrapNode innerNode . docSeq $ [appSep instanceDoc] ++ [ makeForallDoc foralls | Just foralls <- [bndrsMay] ] @@ -998,8 +996,8 @@ layoutTyFamInstDecl inClass (L loc tfid) = do ++ intersperse docSeparator (layoutHsTyPats pats) ++ [ docParenR | needsParens ] hasComments <- (||) - <$> hasAnyRegularCommentsConnected lfeqn - <*> hasAnyRegularCommentsRest linst + <$> hasAnyRegularCommentsConnected outerNode + <*> hasAnyRegularCommentsRest innerNode typeDoc <- docSharedWrapper layoutType typ layoutLhsAndType hasComments lhs "=" typeDoc @@ -1085,8 +1083,8 @@ layoutClsInst lcid@(L _ cid) = docLines layoutAndLocateTyFamInsts :: ToBriDocC (TyFamInstDecl GhcPs) (Located BriDocNumbered) - layoutAndLocateTyFamInsts ltfid@(L loc _) = - L loc <$> layoutTyFamInstDecl True ltfid + layoutAndLocateTyFamInsts ltfid@(L loc tfid) = + L loc <$> layoutTyFamInstDecl True ltfid tfid layoutAndLocateDataFamInsts :: ToBriDocC (DataFamInstDecl GhcPs) (Located BriDocNumbered) @@ -1168,13 +1166,12 @@ layoutLhsAndType -> ToBriDocM BriDocNumbered -> ToBriDocM BriDocNumbered layoutLhsAndType hasComments lhs sep typeDoc = do - let sepDoc = appSep . docLit $ Text.pack sep runFilteredAlternative $ do -- (separators probably are "=" or "::") -- lhs = type -- lhs :: type - addAlternativeCond (not hasComments) - $ docSeq [lhs, sepDoc, docForceSingleline typeDoc] + addAlternativeCond (not hasComments) $ docSeq + [lhs, docSeparator, docLitS sep, docSeparator, docForceSingleline typeDoc] -- lhs -- :: typeA -- -> typeB @@ -1183,4 +1180,6 @@ layoutLhsAndType hasComments lhs sep typeDoc = do -- -> typeB addAlternative $ docAddBaseY BrIndentRegular $ docPar lhs $ docCols ColTyOpPrefix - [sepDoc, docAddBaseY (BrIndentSpecial (length sep + 1)) typeDoc] + [ appSep $ docLitS sep + , docAddBaseY (BrIndentSpecial (length sep + 1)) typeDoc + ] -- 2.30.2