From de0c98c664b8269211659608bedec5ad69d42318 Mon Sep 17 00:00:00 2001 From: David Waern Date: Sat, 8 Dec 2007 16:16:03 +0000 Subject: Handle infix operators correctly in the Type -> HsType translation --- src/Haddock/Interface/AttachInstances.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) (limited to 'src') diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index 227de68a..d43213c8 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -9,6 +9,7 @@ module Haddock.Interface.AttachInstances (attachInstances) where import Haddock.Types +import Haddock.GHC.Utils import qualified Data.Map as Map import Data.Map (Map) @@ -129,10 +130,14 @@ toHsType :: Type -> HsType Name toHsType t = case t of TyVarTy v -> HsTyVar (tyVarName v) AppTy a b -> HsAppTy (toLHsType a) (toLHsType b) + TyConApp tc ts -> case ts of - [] -> HsTyVar (tyConName tc) - _ -> app (tycon tc) ts - FunTy a b -> HsFunTy (toLHsType a) (toLHsType b) + t1:t2:rest + | isNameConSym . tyConName $ tc -> + app (HsOpTy (toLHsType t1) (noLoc . tyConName $ tc) (toLHsType t2)) rest + _ -> app (tycon tc) ts + + FunTy a b -> HsFunTy (toLHsType a) (toLHsType b) ForAllTy v t -> cvForAll [v] t PredTy p -> HsPredTy (toHsPred p) NoteTy _ t -> toHsType t -- cgit v1.2.3