aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <unknown>2007-07-11 20:37:11 +0000
committerDavid Waern <unknown>2007-07-11 20:37:11 +0000
commit3fe640b29fccb30943612ec1b99b8cd1dbc0fa9f (patch)
tree021bc8f49354f0097251f1656fa8a09e10bce3f4
parent4404d4f8fe162719aca689ae1c786d43501cfd78 (diff)
Follow changes to record constructor representation
-rw-r--r--src/Haddock/Html.hs10
-rw-r--r--src/Haddock/InterfaceFile.hs2
-rw-r--r--src/Haddock/Rename.hs14
-rw-r--r--src/Haddock/Types.hs2
-rw-r--r--src/Haddock/Utils.hs4
-rw-r--r--src/Haddock/Version.hs4
-rw-r--r--src/Main.hs16
7 files changed, 26 insertions, 26 deletions
diff --git a/src/Haddock/Html.hs b/src/Haddock/Html.hs
index 6bd80687..c6b4edf0 100644
--- a/src/Haddock/Html.hs
+++ b/src/Haddock/Html.hs
@@ -33,7 +33,7 @@ import Debug.Trace ( trace )
import Data.Map ( Map )
import qualified Data.Map as Map hiding ( Map )
-import GHC
+import GHC hiding ( NoLink )
import Name
import Module
import PackageConfig ( stringToPackageId )
@@ -1044,8 +1044,8 @@ ppSideBySideConstr (L _ con) = case con_res con of
mbLDoc = con_doc con
mkFunTy a b = noLoc (HsFunTy a b)
-ppSideBySideField :: HsRecField DocName (LHsType DocName) -> HtmlTable
-ppSideBySideField (HsRecField lname ltype mbLDoc) =
+ppSideBySideField :: ConDeclField DocName -> HtmlTable
+ppSideBySideField (ConDeclField lname ltype mbLDoc) =
argBox (ppBinder False (orig lname)
<+> dcolon <+> ppLType ltype) <->
maybeRDocBox mbLDoc
@@ -1077,8 +1077,8 @@ ppHsFullConstr (HsRecDecl _ nm tvs ctxt fields doc) =
)
-}
-ppShortField :: Bool -> HsRecField DocName (LHsType DocName)-> HtmlTable
-ppShortField summary (HsRecField lname ltype mbLDoc)
+ppShortField :: Bool -> ConDeclField DocName -> HtmlTable
+ppShortField summary (ConDeclField lname ltype _)
= tda [theclass "recfield"] << (
ppBinder summary (orig lname)
<+> dcolon <+> ppLType ltype
diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs
index c4f24bef..5e8a9424 100644
--- a/src/Haddock/InterfaceFile.hs
+++ b/src/Haddock/InterfaceFile.hs
@@ -182,7 +182,7 @@ fromOnDiskName arr nc (pid, mod_name, occ) =
let
us = nsUniqs nc
uniq = uniqFromSupply us
- name = mkExternalName uniq mod occ noSrcLoc
+ name = mkExternalName uniq mod occ noSrcSpan
new_cache = extendNameCache cache mod occ name
in
case splitUniqSupply us of { (us',_) ->
diff --git a/src/Haddock/Rename.hs b/src/Haddock/Rename.hs
index 7e12a412..6ba07215 100644
--- a/src/Haddock/Rename.hs
+++ b/src/Haddock/Rename.hs
@@ -11,7 +11,7 @@ module Haddock.Rename (
import Haddock.Types
-import GHC
+import GHC hiding ( NoLink )
import BasicTypes
import SrcLoc
import Bag ( emptyBag )
@@ -186,7 +186,7 @@ renameType t = case t of
return (HsDocTy t' doc')
_ -> error "renameType"
-
+
renameLTyVarBndr (L loc tv) = do
name' <- rename (hsTyVarName tv)
return $ L loc (replaceTyVarName tv name')
@@ -261,11 +261,11 @@ renameTyClD d = case d of
a' <- renameLType a
b' <- renameLType b
return (InfixCon a' b')
-
- renameField (HsRecField id arg doc) = do
- arg' <- renameLType arg
- doc' <- mapM renameLDoc doc
- return (HsRecField (keepL id) arg' doc')
+
+ renameField (ConDeclField name t doc) = do
+ t' <- renameLType t
+ doc' <- mapM renameLDoc doc
+ return (ConDeclField (keepL name) t' doc')
renameResType (ResTyH98) = return ResTyH98
renameResType (ResTyGADT t) = return . ResTyGADT =<< renameLType t
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 4c4587ac..6ae2309e 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -8,7 +8,7 @@
module Haddock.Types where
-import GHC
+import GHC hiding (NoLink)
import Outputable
import Data.Map
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 27f60e4a..a7f5f8a9 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -95,8 +95,8 @@ restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
-- 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]
+ field_avail (ConDeclField n _ _) = (unLoc n) `elem` names
+ field_types flds = [ t | ConDeclField _ t _ <- flds ]
keep d | otherwise = Nothing
diff --git a/src/Haddock/Version.hs b/src/Haddock/Version.hs
index f4d02b7d..3df24f1c 100644
--- a/src/Haddock/Version.hs
+++ b/src/Haddock/Version.hs
@@ -8,8 +8,8 @@ module Haddock.Version (
projectName, projectVersion, projectUrl
) where
-import Paths_haddock_ghc ( version )
-import Data.Version ( showVersion )
+import Paths_haddock ( version )
+import Data.Version ( showVersion )
projectName, projectUrl :: String
projectName = "Haddock-GHC"
diff --git a/src/Main.hs b/src/Main.hs
index 28723e71..e5132378 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -17,7 +17,7 @@ import Haddock.Version
import Haddock.InterfaceFile
import Haddock.Exception
import Haddock.Utils.GHC
-import Paths_haddock_ghc ( getDataDir )
+import Paths_haddock ( getDataDir )
import Prelude hiding ( catch )
import Control.Exception
@@ -47,7 +47,7 @@ import qualified Data.Map as Map
import Data.Map (Map)
import Distribution.InstalledPackageInfo ( InstalledPackageInfo(..) )
-import Distribution.Simple.Utils ( withTempFile )
+import Distribution.Simple.Utils
import GHC
import Outputable
@@ -301,8 +301,8 @@ byeVersion =
startGHC :: String -> IO (Session, DynFlags)
startGHC libDir = do
- let ghcMode = BatchCompile
- session <- newSession ghcMode (Just libDir)
+ --let ghcMode = BatchCompile
+ session <- newSession (Just libDir)
flags <- getSessionDynFlags session
flags' <- liftM fst (initPackages flags)
let flags'' = dopt_set flags' Opt_Haddock
@@ -575,7 +575,7 @@ mkDocMap group = Map.fromList (topDeclDocs ++ classMethDocs ++ recordFieldDocs)
classMethDocs = concatMap (collectDocs . collectClassEntities) classes
recordFieldDocs = [ (unLoc lname, doc) |
- HsRecField lname _ (Just (L _ doc)) <- fields ]
+ ConDeclField lname _ (Just (L _ doc)) <- fields ]
--------------------------------------------------------------------------------
-- Source code entities
@@ -937,11 +937,11 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm mdl t tvs (L _ con : rest) =
case con_details con of
- RecCon fields | (HsRecField n ty _ : _) <- matching_fields fields ->
+ RecCon fields | (ConDeclField n ty _ : _) <- matching_fields fields ->
L (getLoc n) (TypeSig (noLoc nm) (noLoc (HsFunTy data_ty (getBangType ty))))
_ -> extractRecSel nm mdl t tvs rest
where
- matching_fields flds = [ f | f@(HsRecField n _ _) <- flds, (unLoc n) == nm ]
+ matching_fields flds = [ f | f@(ConDeclField n _ _) <- flds, (unLoc n) == nm ]
data_ty = foldl (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) (map toTypeNoLoc tvs)
-- -----------------------------------------------------------------------------
@@ -1044,7 +1044,7 @@ buildGlobalDocEnv modules
keep_new env n = Map.insert n (nameSetMod n modName) env
nameSetMod n newMod = mkExternalName (nameUnique n) newMod (nameOccName n)
- (nameSrcLoc n)
+ (nameSrcSpan n)
-- -----------------------------------------------------------------------------
-- Named documentation