aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/HaddockHtml.hs31
-rw-r--r--src/HaddockRename.hs25
-rw-r--r--src/Main.hs13
3 files changed, 27 insertions, 42 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 0dd7a189..d43b8270 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -41,7 +41,7 @@ import RdrName hiding ( Qual )
import SrcLoc
import FastString ( unpackFS )
import BasicTypes ( IPName(..), Boxity(..) )
-import Kind
+import Type ( Kind )
import Outputable ( ppr, defaultUserStyle, showSDoc )
-- the base, module and entity URLs for the source code and wiki links.
@@ -721,7 +721,8 @@ ppFor summary links loc mbDoc (ForeignImport lname ltype _)
= ppSig summary links loc mbDoc (TypeSig lname ltype)
ppFor _ _ _ _ _ = error "ppFor"
-ppTySyn summary links loc mbDoc (TySynonym lname ltyvars ltype)
+-- we skip type patterns for now
+ppTySyn summary links loc mbDoc (TySynonym lname ltyvars _ ltype)
= declWithDoc summary links loc n mbDoc (
hsep ([keyword "type", ppBinder summary n]
++ ppTyVars ltyvars) <+> equals <+> ppLType ltype)
@@ -757,10 +758,9 @@ pp_hs_context cxt = parenList (map ppPred cxt)
ppLPred = ppPred . unLoc
ppPred (HsClassP n ts) = ppDocName n <+> hsep (map ppLType ts)
-ppPred (HsIParam (Dupable n) t)
+-- TODO: find out what happened to the Dupable/Linear distinction
+ppPred (HsIParam (IPName n) t)
= toHtml "?" +++ ppDocName n <+> dcolon <+> ppLType t
-ppPred (HsIParam (Linear n) t)
- = toHtml "%" +++ ppDocName n <+> dcolon <+> ppLType t
-- -----------------------------------------------------------------------------
-- Class declarations
@@ -783,8 +783,9 @@ ppFds fds =
fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
hsep (map ppDocName vars2)
+-- we skip ATs for now
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ _) loc docMap =
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ _ _) loc docMap =
if null sigs
then (if summary then declBox else topDeclBox links loc nm) hdr
else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
@@ -798,11 +799,12 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ _) loc docM
hdr = ppClassHdr summary lctxt nm tvs fds
NoLink nm = unLoc lname
+-- we skip ATs for now
ppClassDecl :: Ord key => Bool -> LinksInfo -> [InstHead DocName] -> key -> SrcSpan ->
Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName ->
HtmlTable
ppClassDecl summary links instances orig_c loc mbDoc docMap
- decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ _)
+ decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ _ _)
| summary = ppShortClassDecl summary links decl loc docMap
| otherwise
= classheader </>
@@ -1075,20 +1077,7 @@ ppDataHeader summary newOrData name tyvars =
-- ----------------------------------------------------------------------------
-- Types and contexts
-ppVar = ppOccName . kindVarOcc
-
-ppParendKind k@(FunKind _ _) = parens (ppKind k)
-ppParendKind k = ppKind k
-
-ppKind kind = case kind of
- LiftedTypeKind -> char '*'
- OpenTypeKind -> char '?'
- UnboxedTypeKind -> char '#'
- UnliftedTypeKind -> char '!'
- UbxTupleKind -> toHtml "(#)"
- ArgTypeKind -> toHtml "??"
- FunKind k1 k2 -> hsep [ppParendKind k1, arrow <+> ppKind k2]
- KindVar v -> ppVar v
+ppKind k = toHtml $ showSDoc (ppr k)
{-
ppForAll Implicit _ lctxt = ppCtxtPart lctxt
diff --git a/src/HaddockRename.hs b/src/HaddockRename.hs
index a5e2daa5..f5c5f99c 100644
--- a/src/HaddockRename.hs
+++ b/src/HaddockRename.hs
@@ -132,14 +132,10 @@ renamePred (HsClassP name types) = do
name' <- rename name
types' <- mapM renameLType types
return (HsClassP name' types')
-renamePred (HsIParam (Dupable name) t) = do
+renamePred (HsIParam (IPName name) t) = do
name' <- rename name
t' <- renameLType t
- return (HsIParam (Dupable name') t')
-renamePred (HsIParam (Linear name) t) = do
- name' <- rename name
- t' <- renameLType t
- return (HsIParam (Linear name') t')
+ return (HsIParam (IPName name') t')
renameLType (L loc t) = return . L loc =<< renameType t
@@ -226,25 +222,28 @@ renameTyClD d = case d of
-- name' <- renameL name
-- return (ForeignType name' a b)
- TyData x lcontext lname ltyvars k cons _ -> do
+ TyData x lcontext lname ltyvars _ k cons _ -> do
lcontext' <- renameLContext lcontext
ltyvars' <- mapM renameLTyVarBndr ltyvars
cons' <- mapM renameLCon cons
- -- we don't need the derivings
- return (TyData x lcontext' (keepL lname) ltyvars' k cons' Nothing)
+ -- I don't think we need the derivings, so we return Nothing
+ -- We skip the type patterns too. TODO: find out what they are :-)
+ return (TyData x lcontext' (keepL lname) ltyvars' Nothing k cons' Nothing)
- TySynonym lname ltyvars ltype -> do
+ TySynonym lname ltyvars typat ltype -> do
ltyvars' <- mapM renameLTyVarBndr ltyvars
ltype' <- renameLType ltype
- return (TySynonym (keepL lname) ltyvars' ltype')
+ -- We skip type patterns here as well.
+ return (TySynonym (keepL lname) ltyvars' Nothing ltype')
- ClassDecl lcontext lname ltyvars lfundeps lsigs _ _ -> do
+ ClassDecl lcontext lname ltyvars lfundeps lsigs _ _ _ -> do
lcontext' <- renameLContext lcontext
ltyvars' <- mapM renameLTyVarBndr ltyvars
lfundeps' <- mapM renameLFunDep lfundeps
lsigs' <- mapM renameLSig lsigs
-- we don't need the default methods or the already collected doc entities
- return (ClassDecl lcontext' (keepL lname) ltyvars' lfundeps' lsigs' emptyBag [])
+ -- we skip the ATs for now.
+ return (ClassDecl lcontext' (keepL lname) ltyvars' lfundeps' lsigs' emptyBag [] [])
where
renameLCon (L loc con) = return . L loc =<< renameCon con
diff --git a/src/Main.hs b/src/Main.hs
index acf9893a..1b3cc0fa 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -35,8 +35,7 @@ import Data.Map (Map)
import Distribution.InstalledPackageInfo ( InstalledPackageInfo(..) )
-import qualified GHC ( init )
-import GHC hiding ( init )
+import GHC
import Outputable
import SrcLoc
import Digraph ( flattenSCC )
@@ -55,7 +54,6 @@ import FastString
import DynFlags hiding ( Option )
import Packages hiding ( package )
import StaticFlags ( parseStaticFlags )
-import Unique ( mkUnique )
-----------------------------------------------------------------------------
-- Top-level stuff
@@ -183,11 +181,10 @@ extractGHCFlags flags = [ flag | Flag_GHCFlag flag <- flags ]
startGHC :: String -> IO (Session, DynFlags)
startGHC libDir = do
- GHC.init (Just libDir)
let ghcMode = BatchCompile
- session <- newSession ghcMode
+ session <- newSession ghcMode (Just libDir)
flags <- getSessionDynFlags session
- flags' <- initPackages flags
+ flags' <- liftM fst (initPackages flags)
let flags'' = dopt_set flags' Opt_Haddock
return (session, flags'')
@@ -1213,8 +1210,8 @@ packageDocEnv mods infos = concatMap moduleDocEnv (zip mods infos)
getPackages :: Session -> DynFlags -> IO [PackageData]
getPackages session dynflags = do
- -- get InstalledPackageInfo's for every package in the session
- pkgInfos <- getExplicitPackagesAnd dynflags []
+ -- get InstalledPackageInfos for every package in the session
+ pkgInfos <- getPreloadPackagesAnd dynflags []
-- return a list of those packages that we could create PackageData's for
let pkgInfos' = filter notRTS pkgInfos
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 12:39:53 +0000