[commit: haddock] ghc-head, wip/T14529, wip/revert-ttg-2017-11-20, wip/ttg4-constraints-2017-11-13, wip/ttg6-unrevert-2017-11-22: Actually render infix type operators as infix (#703) (5b87430)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,wip/T14529,wip/revert-ttg-2017-11-20,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/5b87430a116235940e76c6d9302b34cf64cd8b95

>---------------------------------------------------------------

commit 5b87430a116235940e76c6d9302b34cf64cd8b95
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Tue Nov 14 09:27:03 2017 -0500

    Actually render infix type operators as infix (#703)
    
    * Actually render infix type operators as infix
    
    * Account for things like `(f :*: g) p`, too


>---------------------------------------------------------------

5b87430a116235940e76c6d9302b34cf64cd8b95
 haddock-api/src/Haddock/Convert.hs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index c9d4677..0e57ab4 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