hexagoxel
/
brittany
1
0
Fork 0
Code Issues 117 Pull Requests 5 Packages Projects Releases 5 Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Language/Haskell/Brittany/Internal/Layouters/Type.hs
View File

@ -48,7 +48,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
]
NotPromoted -> docWrapNode name $ docLit t
HsForAllTy _ hsf (L _ (HsQualTy _ (L _ cntxts) typ2)) -> do
let bndrs = hsf_vis_bndrs hsf
let bndrs = getBinders hsf
typeDoc <- docSharedWrapper layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
cntxtDocs <- cntxts `forM` docSharedWrapper layoutType
@ -135,7 +135,7 @@ layoutType ltype@(L _ typ) = docWrapNode ltype $ case typ of
)
]
HsForAllTy _ hsf typ2 -> do
let bndrs = hsf_vis_bndrs hsf
let bndrs = getBinders hsf
typeDoc <- layoutType typ2
tyVarDocs <- layoutTyVarBndrs bndrs
let maybeForceML = case typ2 of
@ -647,3 +647,15 @@ processTyVarBndrsSingleline bndrDocs = bndrDocs >>= \case
, docForceSingleline $ doc
, 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