aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/AttachInstances.hs
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2015-12-08 23:54:34 -0500
committerMatthew Pickering <matthewtpickering@gmail.com>2015-12-14 15:59:55 +0000
commit50c0faf18a5c963c0df874aa94b034430280856a (patch)
treec1af6255ad2190c72c7e5ab637cacb38d5744ef8 /haddock-api/src/Haddock/Interface/AttachInstances.hs
parentcc20c0da2a9d8065e9d2f2470725e41353767214 (diff)
Update for type=kinds
Diffstat (limited to 'haddock-api/src/Haddock/Interface/AttachInstances.hs')
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs24
1 files changed, 17 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 21569374..56382341 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -22,6 +22,7 @@ import Control.Arrow hiding ((<+>))
import Data.List
import Data.Ord (comparing)
import Data.Function (on)
+import Data.Maybe ( maybeToList, mapMaybe )
import qualified Data.Map as Map
import qualified Data.Set as Set
@@ -42,7 +43,7 @@ import SrcLoc
import TcRnDriver (tcRnGetInfo)
import TcType (tcSplitSigmaTy)
import TyCon
-import TypeRep
+import TyCoRep
import TysPrim( funTyCon )
import Var hiding (varName)
#define FSLIT(x) (mkFastString# (x#))
@@ -160,18 +161,26 @@ instHead (_, _, cls, args)
argCount :: Type -> Int
argCount (AppTy t _) = argCount t + 1
argCount (TyConApp _ ts) = length ts
-argCount (FunTy _ _ ) = 2
+argCount (ForAllTy (Anon _) _ ) = 2
argCount (ForAllTy _ t) = argCount t
+argCount (CastTy t _) = argCount t
argCount _ = 0
simplify :: Type -> SimpleType
+simplify (ForAllTy (Anon t1) t2) = SimpleType funTyConName [simplify t1, simplify t2]
simplify (ForAllTy _ t) = simplify t
-simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2]
-simplify (AppTy t1 t2) = SimpleType s (ts ++ [simplify t2])
+simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2))
where (SimpleType s ts) = simplify t1
simplify (TyVarTy v) = SimpleType (tyVarName v) []
-simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
+simplify (TyConApp tc ts) = SimpleType (tyConName tc)
+ (mapMaybe simplify_maybe ts)
simplify (LitTy l) = SimpleTyLit l
+simplify (CastTy ty _) = simplify ty
+simplify (CoercionTy _) = error "simplify:Coercion"
+
+simplify_maybe :: Type -> Maybe SimpleType
+simplify_maybe (CoercionTy {}) = Nothing
+simplify_maybe ty = Just (simplify ty)
-- Used for sorting
instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
@@ -221,9 +230,10 @@ isTypeHidden expInfo = typeHidden
TyVarTy {} -> False
AppTy t1 t2 -> typeHidden t1 || typeHidden t2
TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args
- FunTy t1 t2 -> typeHidden t1 || typeHidden t2
- ForAllTy _ ty -> typeHidden ty
+ ForAllTy bndr ty -> typeHidden (binderType bndr) || typeHidden ty
LitTy _ -> False
+ CastTy ty _ -> typeHidden ty
+ CoercionTy {} -> False
nameHidden :: Name -> Bool
nameHidden = isNameHidden expInfo