aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Waern <unknown>2007-08-30 16:42:59 +0000
committerDavid Waern <unknown>2007-08-30 16:42:59 +0000
commitf9f38d45731906ff67c80fc00f3b7421f258d745 (patch)
tree96281a32cd9f51771ddfc7873cd54885e558a94b
parente185f5ae9c9470b861916aa96933fa72cd703a4e (diff)
Simplify createInterfaces
-rw-r--r--src/Haddock/Interface.hs19
1 files changed, 9 insertions, 10 deletions
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs
index e548f500..e27aefb1 100644
--- a/src/Haddock/Interface.hs
+++ b/src/Haddock/Interface.hs
@@ -34,16 +34,23 @@ import Name
-- return the home link environment created in the process, and any error
-- messages.
createInterfaces :: [GhcModule] -> LinkEnv -> [Flag] -> ([Interface], LinkEnv, [ErrMsg])
-createInterfaces modules extLinks flags = (interfaces, homeLinks, messages)
+createInterfaces modules externalLinks flags = (interfaces, homeLinks, messages)
where
((interfaces, homeLinks), messages) = runWriter $ do
+
-- part 1, create the interfaces
interfaces <- createInterfaces' modules flags
+
-- part 2, attach the instances
let interfaces' = attachInstances interfaces
+
-- part 3, rename the interfaces
- renameInterfaces interfaces' extLinks
+ let homeLinks = buildHomeLinks interfaces
+ let links = homeLinks `Map.union` externalLinks
+ interfaces'' <- mapM (renameInterface links) interfaces'
+ return (interfaces'', homeLinks)
+
createInterfaces' :: [GhcModule] -> [Flag] -> ErrMsgM [Interface]
createInterfaces' modules flags = do
@@ -56,14 +63,6 @@ createInterfaces' modules flags = do
return $ Map.insert (ifaceMod interface) interface map
-renameInterfaces :: [Interface] -> LinkEnv -> ErrMsgM ([Interface], LinkEnv)
-renameInterfaces interfaces externalLinks = do
- let homeLinks = buildHomeLinks interfaces
- let links = homeLinks `Map.union` externalLinks
- interfaces' <- mapM (renameInterface links) interfaces
- return (interfaces', homeLinks)
-
-
-- | Build a mapping which for each original name, points to the "best"
-- place to link to in the documentation. For the definition of
-- "best", we use "the module nearest the bottom of the dependency