diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 8 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 2 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 10 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Types.hs | 13 | 
7 files changed, 23 insertions, 22 deletions
| diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index b7dfad64..bc5588af 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -183,7 +183,7 @@ ppCtor dflags dat subdocs con          name = out dflags $ map unL $ con_names con          resType = case con_res con of -            ResTyH98 -> apps $ map (reL . HsTyVar) $ +            ResTyH98 -> apps $ map (reL . HsTyVar . reL) $                          (tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]              ResTyGADT _ x -> x diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 3514f74e..4aec7917 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -878,7 +878,7 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode          , ppr_mono_lty pREC_TOP ty unicode ]  ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty -ppr_mono_ty _         (HsTyVar name)      _ = ppDocName name +ppr_mono_ty _         (HsTyVar (L _ name)) _ = ppDocName name  ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u  ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys)  ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind) @@ -916,7 +916,7 @@ ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode  ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ = char '_' -ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ = ppDocName name +ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ = ppDocName name  ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index b0a4f503..1aa4d954 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -836,7 +836,7 @@ ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual  ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual  ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html -ppHsTyVarBndr _       qual (UserTyVar   name     ) = +ppHsTyVarBndr _       qual (UserTyVar (L _ name)) =      ppDocName qual Raw False name  ppHsTyVarBndr unicode qual (KindedTyVar name kind) =      parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+> @@ -883,12 +883,12 @@ ppr_mono_ty ctxt_prec (HsQualTy ctxt ty) unicode qual      ppLContext ctxt unicode qual <+> ppr_mono_lty pREC_TOP ty unicode qual  -- UnicodeSyntax alternatives -ppr_mono_ty _ (HsTyVar name) True _ +ppr_mono_ty _ (HsTyVar (L _ name)) True _    | getOccString (getName name) == "*"    = toHtml "★"    | getOccString (getName name) == "(->)" = toHtml "(→)"  ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q ty -ppr_mono_ty _         (HsTyVar name)      _ q = ppDocName q Prefix True name +ppr_mono_ty _         (HsTyVar (L _ name)) _ q = ppDocName q Prefix True name  ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u q = ppr_fun_ty ctxt_prec ty1 ty2 u q  ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys)  ppr_mono_ty _         (HsKindSig ty kind) u q = @@ -927,7 +927,7 @@ ppr_mono_ty ctxt_prec (HsDocTy ty _) unicode qual  ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) _ _ = char '_' -ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) _ q = ppDocName q Prefix True name +ppr_mono_ty _ (HsWildCardTy (NamedWildCard (L _ name))) _ q = ppDocName q Prefix True name  ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index ce71cf86..49c471a4 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -326,7 +326,7 @@ synifyTyVars ktvs = HsQTvs { hsq_kvs = map tyVarName kvs  synifyTyVar :: TyVar -> LHsTyVarBndr Name  synifyTyVar tv -  | isLiftedTypeKind kind = noLoc (UserTyVar name) +  | isLiftedTypeKind kind = noLoc (UserTyVar (noLoc name))    | otherwise             = noLoc (KindedTyVar (noLoc name) (synifyKindSig kind))    where      kind = tyVarKind tv @@ -358,7 +358,7 @@ synifySigWcType :: SynifyTypeState -> Type -> LHsSigWcType Name  synifySigWcType s ty = mkEmptyImplicitBndrs (mkEmptyWildCardBndrs (synifyType s ty))  synifyType :: SynifyTypeState -> Type -> LHsType Name -synifyType _ (TyVarTy tv) = noLoc $ HsTyVar (getName tv) +synifyType _ (TyVarTy tv) = noLoc $ HsTyVar $ noLoc (getName tv)  synifyType _ (TyConApp tc tys)    -- Use non-prefix tuple syntax where possible, because it looks nicer.    | Just sort <- tyConTuple_maybe tc @@ -383,7 +383,7 @@ synifyType _ (TyConApp tc tys)    -- Most TyCons:    | otherwise =      foldl (\t1 t2 -> noLoc (HsAppTy t1 t2)) -      (noLoc $ HsTyVar (getName tc)) +      (noLoc $ HsTyVar $ noLoc (getName tc))        (map (synifyType WithinType) tys)  synifyType _ (AppTy t1 t2) = let    s1 = synifyType WithinType t1 diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 4d45ff9b..da59c5fa 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -810,7 +810,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =                                   , L l n <- ns, selectorFieldOcc n == nm ]    data_ty      | ResTyGADT _ ty <- con_res con = ty -    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) tvs +    | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs  -- | Keep export items with docs.  pruneExportItems :: [ExportItem Name] -> [ExportItem Name] diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 3640d348..eda5f1bf 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -214,7 +214,7 @@ renameType t = case t of      ltype'    <- renameLType ltype      return (HsQualTy { hst_ctxt = lcontext', hst_body = ltype' }) -  HsTyVar n -> return . HsTyVar =<< rename n +  HsTyVar (L l n) -> return . HsTyVar . L l =<< rename n    HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype    HsAppTy a b -> do @@ -269,9 +269,9 @@ renameLHsQTyVars (HsQTvs { hsq_kvs = _, hsq_tvs = tvs })                  -- This is rather bogus, but I'm not sure what else to do  renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName) -renameLTyVarBndr (L loc (UserTyVar n)) +renameLTyVarBndr (L loc (UserTyVar (L l n)))    = do { n' <- rename n -       ; return (L loc (UserTyVar n')) } +       ; return (L loc (UserTyVar (L l n'))) }  renameLTyVarBndr (L loc (KindedTyVar (L lv n) kind))    = do { n' <- rename n         ; kind' <- renameLKind kind @@ -283,8 +283,8 @@ renameLContext (L loc context) = do    return (L loc context')  renameWildCardInfo :: HsWildCardInfo Name -> RnM (HsWildCardInfo DocName) -renameWildCardInfo (AnonWildCard  name) = AnonWildCard  <$> rename name -renameWildCardInfo (NamedWildCard name) = NamedWildCard <$> rename name +renameWildCardInfo (AnonWildCard  (L l name)) = AnonWildCard . L l <$> rename name +renameWildCardInfo (NamedWildCard (L l name)) = NamedWildCard . L l <$> rename name  renameInstHead :: InstHead Name -> RnM (InstHead DocName)  renameInstHead (className, k, types, rest) = do diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 33ab9592..43671de3 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -558,12 +558,13 @@ instance Monad ErrMsgGhc where  -- * Pass sensitive types  ----------------------------------------------------------------------------- -type instance PostRn DocName NameSet  = PlaceHolder -type instance PostRn DocName Fixity   = PlaceHolder -type instance PostRn DocName Bool     = PlaceHolder -type instance PostRn DocName Name     = DocName -type instance PostRn DocName [Name]   = PlaceHolder -type instance PostRn DocName DocName  = DocName +type instance PostRn DocName NameSet        = PlaceHolder +type instance PostRn DocName Fixity         = PlaceHolder +type instance PostRn DocName Bool           = PlaceHolder +type instance PostRn DocName Name           = DocName +type instance PostRn DocName (Located Name) = Located DocName +type instance PostRn DocName [Name]         = PlaceHolder +type instance PostRn DocName DocName        = DocName  type instance PostTc DocName Kind     = PlaceHolder  type instance PostTc DocName Type     = PlaceHolder | 
