diff options
Diffstat (limited to 'haddock-api/src/Haddock/Utils.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 658007ba..45deca9c 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -180,18 +180,32 @@ restrictDataDefn names defn@(HsDataDefn { dd_ND = new_or_data, dd_cons = cons }) restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name] restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ] where - keep d | any (\n -> n `elem` names) (map unLoc $ con_names d) = - case con_details d of + keep d | any (\n -> n `elem` names) (map unLoc $ getConNames d) = + case getConDetails h98d of PrefixCon _ -> Just d RecCon fields | all field_avail (unL fields) -> Just d - | otherwise -> Just (d { con_details = PrefixCon (field_types (map unL (unL fields))) }) + | otherwise -> Just (h98d { con_details = PrefixCon (field_types (map unL (unL fields))) }) -- if we have *all* the field names available, then -- keep the record declaration. Otherwise degrade to -- a constructor declaration. This isn't quite right, but -- it's the best we can do. InfixCon _ _ -> Just d where + h98d = h98ConDecl d + h98ConDecl c@ConDeclH98{} = c + h98ConDecl c@ConDeclGADT{} = c' + where + (details,_res_ty,cxt,tvs) = gadtDeclDetails (con_type c) + c' :: ConDecl Name + c' = ConDeclH98 + { con_name = head (con_names c) + , con_qvars = Just $ HsQTvs { hsq_kvs = mempty, hsq_tvs = tvs } + , con_cxt = Just cxt + , con_details = details + , con_doc = con_doc c + } + field_avail :: LConDeclField Name -> Bool field_avail (L _ (ConDeclField fs _ _)) = all (\f -> selectorFieldOcc (unLoc f) `elem` names) fs |