module Haddock.Interface (
createInterfaces
) where
import Haddock.DocName
import Haddock.Interface.Create
import Haddock.Interface.AttachInstances
import Haddock.Interface.Rename
import Haddock.Types
import Haddock.Options
import Haddock.GHC.Utils
import qualified Data.Map as Map
import Data.Map (Map)
import Data.List
import Control.Monad
import Name
createInterfaces :: [GhcModule] -> LinkEnv -> [Flag] -> ([Interface], LinkEnv, [ErrMsg])
createInterfaces modules externalLinks flags = (interfaces, homeLinks, messages)
where
((interfaces, homeLinks), messages) = runWriter $ do
interfaces <- createInterfaces' modules flags
let homeLinks = buildHomeLinks interfaces
let links = homeLinks `Map.union` externalLinks
let allNames = Map.keys links
let interfaces' = attachInstances interfaces allNames
let warnings = Flag_NoWarnings `notElem` flags
interfaces'' <- mapM (renameInterface links warnings) interfaces'
return (interfaces'', homeLinks)
createInterfaces' :: [GhcModule] -> [Flag] -> ErrMsgM [Interface]
createInterfaces' modules flags = do
resultMap <- foldM addInterface Map.empty modules
return (Map.elems resultMap)
where
addInterface :: ModuleMap -> GhcModule -> ErrMsgM ModuleMap
addInterface map mod = do
interface <- createInterface mod flags map
return $ Map.insert (ifaceMod interface) interface map
buildHomeLinks :: [Interface] -> LinkEnv
buildHomeLinks ifaces = foldl upd Map.empty (reverse ifaces)
where
upd old_env iface
| OptHide `elem` ifaceOptions iface = old_env
| OptNotHome `elem` ifaceOptions iface =
foldl' keep_old old_env exported_names
| otherwise = foldl' keep_new old_env exported_names
where
exported_names = ifaceVisibleExports iface
mod = ifaceMod iface
keep_old env n = Map.insertWith (\new old -> old) n mod env
keep_new env n = Map.insert n mod env