aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface/AttachInstances.hs
diff options
context:
space:
mode:
authorIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-18 02:11:05 +0000
committerIsaac Dupree <id@isaac.cedarswampstudios.org>2009-08-18 02:11:05 +0000
commit9e81f6efcdb3b034e15de394b138118d9c62b499 (patch)
tree55bdec345298c316528d7e700c599972626b9f67 /src/Haddock/Interface/AttachInstances.hs
parenteb1892c10a113d4d98e45ddb5da33b7f2c36e2d9 (diff)
switch AttachInstances to use synify code
It changed an instance from showing ((,) a b) to (a, b) because my synify code is more sophisticated; I hope the latter is a good thing rather than a bad thing aesthetically, here. But this definitely reduces code duplication!
Diffstat (limited to 'src/Haddock/Interface/AttachInstances.hs')
-rw-r--r--src/Haddock/Interface/AttachInstances.hs43
1 files changed, 6 insertions, 37 deletions
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 1f45be01..9da78108 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -14,6 +14,7 @@ module Haddock.Interface.AttachInstances (attachInstances) where
import Haddock.Types
+import Haddock.Convert
import qualified Data.Map as Map
import Data.Map (Map)
@@ -121,41 +122,9 @@ funTyConName = mkWiredInName gHC_PRIM
toHsInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
-toHsInstHead (_, preds, cls, ts) = (map toHsPred preds, className cls, map toHsType ts)
+toHsInstHead (_, preds, cls, ts) =
+ ( map (unLoc . synifyPred) preds
+ , getName cls
+ , map (unLoc . synifyType WithinType) ts
+ )
-
---------------------------------------------------------------------------------
--- Type -> HsType conversion
---------------------------------------------------------------------------------
-
-
-toHsPred :: PredType -> HsPred Name
-toHsPred (ClassP cls ts) = HsClassP (className cls) (map toLHsType ts)
-toHsPred (IParam n t) = HsIParam n (toLHsType t)
-toHsPred (EqPred t1 t2) = HsEqualP (toLHsType t1) (toLHsType t2)
-
-
-toLHsType :: Type -> Located (HsType Name)
-toLHsType = noLoc . toHsType
-
-
-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
- t1:t2:rest
- | isSymOcc . nameOccName . 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 ty -> cvForAll [v] ty
- PredTy p -> HsPredTy (toHsPred p)
- where
- tycon = HsTyVar . tyConName
- app tc = foldl (\a b -> HsAppTy (noLoc a) (noLoc b)) tc . map toHsType
- cvForAll vs (ForAllTy v ty) = cvForAll (v:vs) ty
- cvForAll vs ty = mkExplicitHsForAllTy (tyvarbinders vs) (noLoc []) (toLHsType ty)
- tyvarbinders = map (noLoc . UserTyVar . tyVarName)