diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 21 |
1 files changed, 14 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index c72d5f38..c9290ed0 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -1076,8 +1076,8 @@ extractDecl declMap name decl TyClD _ d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) in if isDataConName name - then SigD noExt <$> extractPatternSyn name n tyvar_tys (dd_cons (tcdDataDefn d)) - else SigD noExt <$> extractRecSel name n tyvar_tys (dd_cons (tcdDataDefn d)) + then SigD noExt <$> extractPatternSyn name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) + else SigD noExt <$> extractRecSel name n (map HsValArg tyvar_tys) (dd_cons (tcdDataDefn d)) TyClD _ FamDecl {} | isValName name , Just (famInst:_) <- M.lookup name declMap @@ -1116,8 +1116,7 @@ extractDecl declMap name decl O.text "Unhandled decl for" O.<+> O.ppr name O.<> O.text ":" O.$$ O.nest 4 (O.ppr decl) - -extractPatternSyn :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn +extractPatternSyn :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn extractPatternSyn nm t tvs cons = case filter matches cons of [] -> error "extractPatternSyn: constructor pattern not found" @@ -1145,9 +1144,13 @@ extractPatternSyn nm t tvs cons = data_ty con | ConDeclGADT{} <- con = con_res_ty con - | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn + mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsTypeArg ki) = HsAppKindTy noExt f ki + mkAppTyArg f (HsArgPar _) = HsParTy noExt f -extractRecSel :: Name -> Name -> [LHsType GhcRn] -> [LConDecl GhcRn] +extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn] -> LSig GhcRn extractRecSel _ _ _ [] = error "extractRecSel: selector not found" @@ -1163,7 +1166,11 @@ extractRecSel nm t tvs (L _ con : rest) = data_ty -- ResTyGADT _ ty <- con_res con = ty | ConDeclGADT{} <- con = con_res_ty con - | otherwise = foldl' (\x y -> noLoc (HsAppTy noExt x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + | otherwise = foldl' (\x y -> noLoc (mkAppTyArg x y)) (noLoc (HsTyVar noExt NotPromoted (noLoc t))) tvs + where mkAppTyArg :: LHsType GhcRn -> LHsTypeArg GhcRn -> HsType GhcRn + mkAppTyArg f (HsValArg ty) = HsAppTy noExt f ty + mkAppTyArg f (HsTypeArg ki) = HsAppKindTy noExt f ki + mkAppTyArg f (HsArgPar _) = HsParTy noExt f -- | Keep export items with docs. pruneExportItems :: [ExportItem GhcRn] -> [ExportItem GhcRn] |