Fix getting binders from `HsForAllTy`

pull/357/head
Taylor Fausak 2021-11-02 02:17:05 +00:00 committed by GitHub
parent 0f035faf3c
commit 22361c4ecd
1 changed files with 14 additions and 2 deletions

View File

@ -48,7 +48,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
] ]
NotPromoted -> docWrapNode name $ docLit t NotPromoted -> docWrapNode name $ docLit t
HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
let bndrs = hsf_vis_bndrs hsf let bndrs = getBinders hsf
typeDoc <- docSharedWrapper layoutType typ2 typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs tyVarDocs <- layoutTyVarBndrs bndrs
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
@ -135,7 +135,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
) )
] ]
HsForAllTy _ hsf typ2 -> do HsForAllTy _ hsf typ2 -> do
let bndrs = hsf_vis_bndrs hsf let bndrs = getBinders hsf
typeDoc <- layoutType typ2 typeDoc <- layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs tyVarDocs <- layoutTyVarBndrs bndrs
let maybeForceML = case typ2 of let maybeForceML = case typ2 of
@ -647,3 +647,15 @@ processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case
, docForceSingleline $ doc , docForceSingleline $ doc
, docLit $ Text.pack ")" , docLit $ Text.pack ")"
] ]
getBinders :: HsForAllTelescope pass -> [LHsTyVarBndr () pass]
getBinders x = case x of
HsForAllVis _ b -> b
HsForAllInvis _ b -> fmap withoutSpecificity b
XHsForAllTelescope _ -> []
withoutSpecificity :: LHsTyVarBndr flag pass -> LHsTyVarBndr () pass
withoutSpecificity = fmap $ \ x -> case x of
UserTyVar a _ c -> UserTyVar a () c
KindedTyVar a _ c d -> KindedTyVar a () c d
XTyVarBndr a -> XTyVarBndr a