From 5b87430a116235940e76c6d9302b34cf64cd8b95 Mon Sep 17 00:00:00 2001
From: Ryan Scott <ryan.gl.scott@gmail.com>
Date: Tue, 14 Nov 2017 09:27:03 -0500
Subject: Actually render infix type operators as infix (#703)

* Actually render infix type operators as infix

* Account for things like `(f :*: g) p`, too
---
 haddock-api/src/Haddock/Convert.hs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

(limited to 'haddock-api/src')

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
-- 
cgit v1.2.3