From 5d8117d8f1f910c85d36865d646b65510b23583d Mon Sep 17 00:00:00 2001 From: Alan Zimmerman Date: Fri, 21 Nov 2014 11:23:09 -0600 Subject: Follow API changes in D426 Signed-off-by: Austin Seipp --- src/Haddock/Backends/Hoogle.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'src/Haddock/Backends/Hoogle.hs') diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs index 4535ce5c..cdd4d56e 100644 --- a/src/Haddock/Backends/Hoogle.hs +++ b/src/Haddock/Backends/Hoogle.hs @@ -184,21 +184,21 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of _ -> [] ppCtor :: DynFlags -> TyClDecl Name -> [(Name, DocForDecl Name)] -> ConDecl Name -> [String] -ppCtor dflags dat subdocs con = lookupCon dflags subdocs (con_name con) - ++ f (con_details con) +ppCtor dflags dat subdocs con + = concatMap (lookupCon dflags subdocs) (con_names con) ++ f (con_details con) where f (PrefixCon args) = [typeSig name $ args ++ [resType]] f (InfixCon a1 a2) = f $ PrefixCon [a1,a2] - f (RecCon recs) = f (PrefixCon $ map cd_fld_type recs) ++ concat - [lookupCon dflags subdocs (cd_fld_name r) ++ - [out dflags (unL $ cd_fld_name r) `typeSig` [resType, cd_fld_type r]] - | r <- recs] + f (RecCon recs) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat + [(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++ + [out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]] + | r <- map unLoc recs] funs = foldr1 (\x y -> reL $ HsFunTy (makeExplicitL x) (makeExplicitL y)) apps = foldl1 (\x y -> reL $ HsAppTy x y) typeSig nm flds = operator nm ++ " :: " ++ outHsType dflags (makeExplicit $ unL $ funs flds) - name = out dflags $ unL $ con_name con + name = out dflags $ map unL $ con_names con resType = case con_res con of ResTyH98 -> apps $ map (reL . HsTyVar) $ -- cgit v1.2.3