aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
authorIavor S. Diatchki <iavor.diatchki@gmail.com>2012-03-19 20:12:18 -0700
committerIavor S. Diatchki <iavor.diatchki@gmail.com>2012-03-19 20:12:18 -0700
commit4604487195dbeae627f3c9f9c9f590c25b6634d4 (patch)
tree5310991c3127942d39398ee2a5f3d2755990d43e /src/Haddock
parentfa5ffbd629ed466f6e1f121b805f2114e6b2bd47 (diff)
parentcc86b10577d0dcecd5c86102cb601caa474d3d6a (diff)
Merge remote-tracking branch 'origin/master' into type-nats
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs2
-rw-r--r--src/Haddock/Convert.hs17
-rw-r--r--src/Haddock/Interface/Rename.hs15
3 files changed, 18 insertions, 16 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index adb1d598..94753f23 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -164,7 +164,7 @@ ppTyFamHeader summary associated decl unicode qual =
ppTyClBinderWithVars summary decl <+>
case tcdKindSig decl of
- Just kind -> dcolon unicode <+> ppLKind unicode qual kind
+ Just (HsBSig kind _) -> dcolon unicode <+> ppLKind unicode qual kind
Nothing -> noHtml
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 54845787..42c3bf1b 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -104,15 +104,14 @@ synifyTyCon tc
(zipWith
(\fakeTyVar realKind -> noLoc $
KindedTyVar (getName fakeTyVar)
- (HsBSig (synifyKind realKind) placeHolderBndrs)
- placeHolderKind)
+ (synifyKindSig realKind))
alphaTyVars --a, b, c... which are unfortunately all kind *
(fst . splitKindFunTys $ tyConKind tc)
)
-- assume primitive types aren't members of data/newtype families:
Nothing
-- we have their kind accurately:
- (Just (synifyKind (tyConKind tc)))
+ (Just (synifyKindSig (tyConKind tc)))
-- no algebraic constructors:
[]
-- "deriving" needn't be specified:
@@ -121,7 +120,7 @@ synifyTyCon tc
case synTyConRhs tc of
SynFamilyTyCon ->
TyFamily TypeFamily (synifyName tc) (synifyTyVars (tyConTyVars tc))
- (Just (synifyKind (synTyConResKind tc))) -- placeHolderKind
+ (Just (synifyKindSig (synTyConResKind tc)))
_ -> error "synifyTyCon: impossible open type synonym?"
| isDataFamilyTyCon tc = --(why no "isOpenAlgTyCon"?)
case algTyConRhs tc of
@@ -167,7 +166,7 @@ synifyTyCon tc
syn_type = synifyType WithinType (synTyConType tc)
in if isSynTyCon tc
then TySynonym name tyvars typats syn_type placeHolderNames
- else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKind alg_kindSig) alg_cons alg_deriv
+ else TyData alg_nd alg_ctx name Nothing tyvars typats (fmap synifyKindSig alg_kindSig) alg_cons alg_deriv
-- User beware: it is your responsibility to pass True (use_gadt_syntax)
@@ -240,8 +239,8 @@ synifyTyVars = map synifyTyVar
kind = tyVarKind tv
name = getName tv
in if isLiftedTypeKind kind
- then UserTyVar name placeHolderKind
- else KindedTyVar name (HsBSig (synifyKind kind) placeHolderBndrs) placeHolderKind
+ then UserTyVar name
+ else KindedTyVar name (synifyKindSig kind)
--states of what to do with foralls:
@@ -314,8 +313,8 @@ synifyTyLit :: TyLit -> HsTyLit
synifyTyLit (NumTyLit n) = HsNumTy n
synifyTyLit (StrTyLit s) = HsStrTy s
-synifyKind :: Kind -> LHsKind Name
-synifyKind = synifyType (error "synifyKind")
+synifyKindSig :: Kind -> HsBndrSig (LHsKind Name)
+synifyKindSig k = HsBSig (synifyType (error "synifyKind") k) placeHolderBndrs
synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
([HsType Name], Name, [HsType Name])
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a295fe29..6034688e 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -206,9 +206,12 @@ renameLType = mapM renameType
renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
renameLKind = renameLType
-renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
+renameMaybeLKind :: Maybe (HsBndrSig (LHsKind Name))
+ -> RnM (Maybe (HsBndrSig (LHsKind DocName)))
renameMaybeLKind Nothing = return Nothing
-renameMaybeLKind (Just ki) = renameLKind ki >>= return . Just
+renameMaybeLKind (Just (HsBSig ki fvs))
+ = do { ki' <- renameLKind ki
+ ; return (Just (HsBSig ki' fvs)) }
renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of
@@ -260,13 +263,13 @@ renameType t = case t of
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
-renameLTyVarBndr (L loc (UserTyVar n tck))
+renameLTyVarBndr (L loc (UserTyVar n))
= do { n' <- rename n
- ; return (L loc (UserTyVar n' tck)) }
-renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs) tck))
+ ; return (L loc (UserTyVar n')) }
+renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs)))
= do { n' <- rename n
; k' <- renameLKind k
- ; return (L loc (KindedTyVar n' (HsBSig k' fvs) tck)) }
+ ; return (L loc (KindedTyVar n' (HsBSig k' fvs))) }
renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
renameLContext (L loc context) = do