diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 9 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 7 | 
6 files changed, 17 insertions, 11 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs index e8baae88..be17cb8b 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Ast.hs @@ -117,7 +117,7 @@ decls (group, _, _, _) = concatMap ($ group)      ]    where      typ (GHC.L _ t) = case t of -        GHC.DataDecl name _ _ _ -> pure . decl $ name +        GHC.DataDecl { tcdLName = name } -> pure . decl $ name          GHC.SynDecl name _ _ _ -> pure . decl $ name          GHC.FamDecl fam -> pure . decl $ GHC.fdLName fam          GHC.ClassDecl{..} -> [decl tcdLName] ++ concatMap sig tcdSigs diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index b7be7ffb..81a23a1b 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -641,7 +641,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con@(ConDeclH98 {})) =      ppOcc   = case occ of        [one] -> ppBinder one        _     -> cat (punctuate comma (map ppBinder occ)) -    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)) +    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))      context = unLoc (fromMaybe (noLoc []) (con_cxt con))      -- don't use "con_doc con", in case it's reconstructed from a .hi file, diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 2f802aef..b354658d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -776,7 +776,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con of        [one] -> ppBinderInfix summary one        _     -> hsep (punctuate comma (map (ppBinderInfix summary) occ)) -    ltvs     = fromMaybe (HsQTvs PlaceHolder []) (con_qvars con) +    ltvs     = fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con)      tyVars   = tyvarNames ltvs      lcontext = fromMaybe (noLoc []) (con_cxt con)      context  = unLoc lcontext @@ -846,7 +846,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con)        [one] -> ppBinderInfix False one        _     -> hsep (punctuate comma (map (ppBinderInfix False) occ)) -    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder []) (con_qvars con)) +    tyVars  = tyvarNames (fromMaybe (HsQTvs PlaceHolder [] PlaceHolder) (con_qvars con))      context = unLoc (fromMaybe (noLoc []) (con_cxt con))      forall_ = False      -- don't use "con_doc con", in case it's reconstructed from a .hi file, diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index fa6d801c..b651c86b 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -26,6 +26,7 @@ import DataCon  import FamInstEnv  import HsSyn  import Name +import NameSet ( emptyNameSet )  import RdrName ( mkVarUnqual )  import PatSyn  import SrcLoc ( Located, noLoc, unLoc ) @@ -144,7 +145,7 @@ synifyTyCon _coax tc                           in HsQTvs { hsq_implicit = []   -- No kind polymorphism                                     , hsq_explicit = zipWith mk_hs_tv (fst (splitFunTys (tyConKind tc)))                                                                  alphaTyVars --a, b, c... which are unfortunately all kind * -                                   } +                                   , hsq_dependent = emptyNameSet }             , tcdDataDefn = HsDataDefn { dd_ND = DataType  -- arbitrary lie, they are neither                                                      -- algebraic data nor newtype: @@ -154,6 +155,7 @@ synifyTyCon _coax tc                                                 -- we have their kind accurately:                                        , dd_cons = []  -- No constructors                                        , dd_derivs = Nothing } +           , tcdDataCusk = False             , tcdFVs = placeHolderNamesTc }  synifyTyCon _coax tc @@ -233,7 +235,7 @@ synifyTyCon coax tc   in case lefts consRaw of    [] -> return $          DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn -                 , tcdFVs = placeHolderNamesTc } +                 , tcdDataCusk = False, tcdFVs = placeHolderNamesTc }    dataConErrs -> Left $ unlines dataConErrs  synifyInjectivityAnn :: Maybe Name -> [TyVar] -> Injectivity @@ -322,7 +324,8 @@ synifyCtx = noLoc . map (synifyType WithinType)  synifyTyVars :: [TyVar] -> LHsQTyVars Name  synifyTyVars ktvs = HsQTvs { hsq_implicit = [] -                           , hsq_explicit = map synifyTyVar ktvs } +                           , hsq_explicit = map synifyTyVar ktvs +                           , hsq_dependent = emptyNameSet }  synifyTyVar :: TyVar -> LHsTyVarBndr Name  synifyTyVar tv diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 0f97ee3b..3054e2f9 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -270,7 +270,7 @@ renameType t = case t of  renameLHsQTyVars :: LHsQTyVars Name -> RnM (LHsQTyVars DocName)  renameLHsQTyVars (HsQTvs { hsq_implicit = _, hsq_explicit = tvs })    = do { tvs' <- mapM renameLTyVarBndr tvs -       ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs' }) } +       ; return (HsQTvs { hsq_implicit = error "haddock:renameLHsQTyVars", hsq_explicit = tvs', hsq_dependent = error "haddock:renameLHsQTyVars" }) }                  -- This is rather bogus, but I'm not sure what else to do  renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) @@ -350,7 +350,7 @@ renameTyClD d = case d of      lname'    <- renameL lname      tyvars'   <- renameLHsQTyVars tyvars      defn'     <- renameDataDefn defn -    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames }) +    return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdDataCusk = PlaceHolder, tcdFVs = placeHolderNames })    ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars              , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index 325dd710..58a7ef90 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -64,6 +64,7 @@ import Haddock.GhcUtils  import GHC  import Name +import NameSet ( emptyNameSet )  import HsTypes (selectorFieldOcc)  import Control.Monad ( liftM ) @@ -201,7 +202,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]              c' = ConDeclH98                     { con_name = head (con_names c)                     , con_qvars = Just $ HsQTvs { hsq_implicit = mempty -                                               , hsq_explicit = tvs } +                                               , hsq_explicit = tvs +                                               , hsq_dependent = emptyNameSet }                     , con_cxt = Just cxt                     , con_details = details                     , con_doc = con_doc c @@ -226,7 +228,8 @@ emptyHsQTvs :: LHsQTyVars Name  -- does not necessarily have all the rigt kind variables.  It is used  -- in Haddock just for printing, so it doesn't matter  emptyHsQTvs = HsQTvs { hsq_implicit = error "haddock:emptyHsQTvs" -                     , hsq_explicit = [] } +                     , hsq_explicit = [] +                     , hsq_dependent = error "haddock:emptyHsQTvs" }  --------------------------------------------------------------------------------  | 
