diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2020-04-05 11:48:39 -0400 |
|---|---|---|
| committer | Alec Theriault <alec.theriault@gmail.com> | 2020-04-05 09:04:43 -0700 |
| commit | 87fbc11227347da805a3d2158d462514438ca742 (patch) | |
| tree | 37c3ce949b4d8fdf6834304e362ce0b5f10199fc /haddock-api | |
| parent | 5d034ee2ed72839a8472dba59f83b1b348691cc5 (diff) | |
Fix #1050 by filtering out invisible AppTy arguments
This makes the `synifyType` case for `AppTy` more intelligent by
taking into consideration the visibilities of each `AppTy` argument
and filtering out any invisible arguments, as they aren't intended
to be displayed in the source code. (See #1050 for an example of what
can happen if you fail to filter these out.)
Along the way, I noticed that a special `synifyType` case for
`AppTy t1 (CoercionTy {})` could be consolidated with the case below
it, so I took the opportunity to tidy this up.
Diffstat (limited to 'haddock-api')
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index d5fa3667..1a1e95bd 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -612,11 +612,14 @@ synifyType _ vs (TyConApp tc tys) in noLoc $ HsKindSig noExtField ty' full_kind' | otherwise = ty' -synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1 -synifyType _ vs (AppTy t1 t2) = let - s1 = synifyType WithinType vs t1 - s2 = synifyType WithinType vs t2 - in noLoc $ HsAppTy noExtField s1 s2 +synifyType _ vs ty@(AppTy {}) = let + (ty_head, ty_args) = splitAppTys ty + ty_head' = synifyType WithinType vs ty_head + ty_args' = map (synifyType WithinType vs) $ + filterOut isCoercionTy $ + filterByList (map isVisibleArgFlag $ appTyArgFlags ty_head ty_args) + ty_args + in foldl (\t1 t2 -> noLoc $ HsAppTy noExtField t1 t2) ty_head' ty_args' synifyType s vs funty@(FunTy InvisArg _ _) = synifyForAllType s Inferred vs funty synifyType _ vs (FunTy VisArg t1 t2) = let s1 = synifyType WithinType vs t1 |