From 809a24cc74b4ca23e69f2f4a857e31c5a440b436 Mon Sep 17 00:00:00 2001
From: Łukasz Hanuszczak <lukasz.hanuszczak@gmail.com>
Date: Wed, 5 Aug 2015 21:30:59 +0200
Subject: Add basic support for sugaring infix type operators.

---
 haddock-api/src/Haddock/Interface/Specialize.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

(limited to 'haddock-api/src/Haddock/Interface')

diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index 59985de6..ddae2b93 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -116,7 +116,7 @@ sugar =
     everywhere $ mkT step
   where
     step :: HsType name -> HsType name
-    step = sugarTuples . sugarLists
+    step = sugarOperators . sugarTuples . sugarLists
 
 
 sugarLists :: NamedThing name => HsType name -> HsType name
@@ -145,6 +145,12 @@ sugarTuples typ =
     aux _ _ = typ
 
 
+sugarOperators :: NamedThing name => HsType name -> HsType name
+sugarOperators (HsAppTy (L _ (HsAppTy (L loc (HsTyVar name)) la)) lb)
+    | isSymOcc $ getOccName name = mkHsOpTy la (L loc name) lb
+sugarOperators typ = typ
+
+
 -- | Compute arity of given tuple operator.
 --
 -- >>> parseTupleArity "(,,)"
-- 
cgit v1.2.3