Fix comments in instance/type instances (#282) #286

Merged
lspitzner merged 1 commits from fix-instance-comment into master 2020-03-24 20:38:28 +01:00
2 changed files with 37 additions and 30 deletions

View File

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

View File

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