diff options
author | David Waern <unknown> | 2007-08-30 16:42:59 +0000 |
---|---|---|
committer | David Waern <unknown> | 2007-08-30 16:42:59 +0000 |
commit | f9f38d45731906ff67c80fc00f3b7421f258d745 (patch) | |
tree | 96281a32cd9f51771ddfc7873cd54885e558a94b | |
parent | e185f5ae9c9470b861916aa96933fa72cd703a4e (diff) |
Simplify createInterfaces
-rw-r--r-- | src/Haddock/Interface.hs | 19 |
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 |