diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2017-11-14 09:27:03 -0500 |
|---|---|---|
| committer | Alexander Biehl <alexbiehl@gmail.com> | 2017-11-14 15:27:03 +0100 |
| commit | 5b87430a116235940e76c6d9302b34cf64cd8b95 (patch) | |
| tree | 457944c265302bb8cf37bd142db4c15fd32c98ea /haddock-api/src/Haddock/Convert.hs | |
| parent | 9f054dc365379c66668de6719840918190ae6e44 (diff) | |
Actually render infix type operators as infix (#703)
* Actually render infix type operators as infix
* Account for things like `(f :*: g) p`, too
Diffstat (limited to 'haddock-api/src/Haddock/Convert.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index c9d4677d..0e57ab42 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -440,14 +440,25 @@ synifyType _ (TyConApp tc tys) = noLoc $ HsIParamTy noExt (noLoc $ HsIPName x) (synifyType WithinType ty) -- and equalities | tc `hasKey` eqTyConKey - , [ty1, ty2] <- tys + , [ty1, ty2] <- vis_tys = noLoc $ HsEqTy noExt (synifyType WithinType ty1) (synifyType WithinType ty2) + -- and infix type operators + | isSymOcc (nameOccName (getName tc)) + , ty1:ty2:tys_rest <- vis_tys + = mk_app_tys (HsOpTy noExt (synifyType WithinType ty1) + (noLoc $ getName tc) + (synifyType WithinType ty2)) + tys_rest -- Most TyCons: - | otherwise = - foldl (\t1 t2 -> noLoc (HsAppTy noExt t1 t2)) - (noLoc $ HsTyVar noExt NotPromoted $ noLoc (getName tc)) - (map (synifyType WithinType) $ - filterOut isCoercionTy vis_tys) + | otherwise + = mk_app_tys (HsTyVar noExt NotPromoted $ noLoc (getName tc)) + vis_tys + where + mk_app_tys ty_app ty_args = + foldl (\t1 t2 -> noLoc $ HsAppTy noExt t1 t2) + (noLoc ty_app) + (map (synifyType WithinType) $ + filterOut isCoercionTy ty_args) vis_tys = filterOutInvisibleTypes tc tys binders = tyConBinders tc |