aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
authorƁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-08-05 21:30:59 +0200
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-08-21 18:22:33 +0100
commit809a24cc74b4ca23e69f2f4a857e31c5a440b436 (patch)
tree9c58192bc73b4b02931ede06e9d6605746d085e7 /haddock-api/src
parent25ea9a3a8fab29490d0957f3b4e55e03458183d2 (diff)
Add basic support for sugaring infix type operators.
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs8
1 files changed, 7 insertions, 1 deletions
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 "(,,)"