aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Convert.hs
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-04-05 11:48:39 -0400
committerAlec Theriault <alec.theriault@gmail.com>2020-04-05 09:04:43 -0700
commit87fbc11227347da805a3d2158d462514438ca742 (patch)
tree37c3ce949b4d8fdf6834304e362ce0b5f10199fc /haddock-api/src/Haddock/Convert.hs
parent5d034ee2ed72839a8472dba59f83b1b348691cc5 (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/src/Haddock/Convert.hs')
-rw-r--r--haddock-api/src/Haddock/Convert.hs13
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