diff options
| author | davve <davve@dtek.chalmers.se> | 2007-02-03 21:23:56 +0000 | 
|---|---|---|
| committer | davve <davve@dtek.chalmers.se> | 2007-02-03 21:23:56 +0000 | 
| commit | 4dd150fe66a1c6d56569793af6d1d4c1a58daf68 (patch) | |
| tree | b22491aec88cae32e20e69a73fa8f93485a032a0 /src | |
| parent | 288ed096e584def7a2a30767e4b6d76177f2f75c (diff) | |
Let restrictCons handle infix constructors
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaddockUtil.hs | 33 | ||||
| -rw-r--r-- | src/Main.hs | 2 | 
2 files changed, 18 insertions, 17 deletions
| diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index 7cdca748..b80e8a1b 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -81,21 +81,24 @@ restrictTo names (L loc decl) = L loc $ case decl of    _ -> decl  restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name] -restrictCons names decls = [ L p (fromJust (keep d)) | L p d <- decls, isJust (keep d) ]   -  where keep d | unLoc (con_name d) `elem` names =  -          case con_details d of -            PrefixCon _ -> Just d -            RecCon fields   -              | all field_avail fields -> Just d -              | otherwise -> Just (d { con_details = PrefixCon (field_types 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. -	   where -            field_avail (HsRecField n _ _) = (unLoc n) `elem` names -            field_types flds = [ ty | HsRecField n ty _ <- flds]  -        keep d | otherwise = Nothing +restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]   +  where  +    keep d | unLoc (con_name d) `elem` names =  +      case con_details d of +        PrefixCon _ -> Just d +        RecCon fields   +          | all field_avail fields -> Just d +          | otherwise -> Just (d { con_details = PrefixCon (field_types 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 +        field_avail (HsRecField n _ _) = (unLoc n) `elem` names +        field_types flds = [ ty | HsRecField n ty _ <- flds]  +       +    keep d | otherwise = Nothing  restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]  restrictDecls names decls = filter keep decls diff --git a/src/Main.hs b/src/Main.hs index 8f61f8d9..59e4b751 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -869,9 +869,7 @@ mkExportItems mod_map this_mod exported_names exportedDeclMap localDeclMap sub_m  		Nothing -> return []  		Just found -> return [ ExportDoc found ] -    -- NOTE: I'm unsure about this. Currently only "External" names are considered.	      declWith :: Name -> ErrMsgM [ ExportItem Name ] -    declWith t | not (isExternalName t) = return []      declWith t  	| (Just decl, maybeDoc) <- findDecl t          = return [ ExportDecl t (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ] | 
