module HDocs.Haddock (
readInstalledDocs,
readHaddock,
readSource,
installedInterfaceDocs, installedInterfacesDocs,
interfaceDocs,
haddockFiles,
readInstalledInterfaces, readPackageInterfaces,
lookupDoc, lookupNameDoc,
module HDocs.Base
) where
import Control.Applicative
import Control.Arrow
import Control.Exception
import Control.Monad.Except
import Data.Map (Map)
import qualified Data.Map as M
import Data.Maybe (listToMaybe)
import Documentation.Haddock
import Documentation.Haddock.Types (_doc)
import DynFlags
import Module
import Name
import PackageConfig
import HDocs.Base
readInstalledDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
readInstalledDocs opts = do
fs <- haddockFiles opts
liftM M.unions $ forM fs $ \f -> (readHaddock f) `mplus` (return M.empty)
readHaddock :: FilePath -> ExceptT String IO (Map String ModuleDocMap)
readHaddock f = M.fromList . map installedInterfaceDocs <$> readInstalledInterfaces f
readSource :: [String] -> FilePath -> ExceptT String IO (String, ModuleDocMap)
readSource opts f = do
ifaces <- liftError $ liftIO $ createInterfaces ([Flag_Verbosity "0", Flag_NoWarnings] ++ map Flag_OptGhc opts) [f]
iface <- maybe (throwError $ "Failed to load docs for " ++ f) return $ listToMaybe ifaces
return $ interfaceDocs iface
installedInterfaceDocs :: InstalledInterface -> (String, ModuleDocMap)
installedInterfaceDocs = stringize . (instMod &&& (fmap _doc . instDocMap))
installedInterfacesDocs :: [InstalledInterface] -> Map String ModuleDocMap
installedInterfacesDocs = M.fromList . map installedInterfaceDocs
interfaceDocs :: Interface -> (String, ModuleDocMap)
interfaceDocs = stringize . (ifaceMod &&& (fmap _doc . ifaceDocMap))
haddockFiles :: [String] -> ExceptT String IO [FilePath]
haddockFiles opts = ExceptT $ withInitializedPackages opts $ return . maybe
(Left "Package database empty")
(Right . concatMap haddockInterfaces) .
pkgDatabase
readInstalledInterfaces :: FilePath -> ExceptT String IO [InstalledInterface]
readInstalledInterfaces f = do
ifile <- liftError $ ExceptT $ readInterfaceFile freshNameCache f
return $ ifInstalledIfaces ifile
readPackageInterfaces :: PackageConfig -> ExceptT String IO [InstalledInterface]
readPackageInterfaces = liftM concat . mapM readInstalledInterfaces . haddockInterfaces
lookupDoc :: String -> String -> Map String ModuleDocMap -> Maybe (Doc String)
lookupDoc m n = M.lookup m >=> M.lookup n
lookupNameDoc :: Name -> Map String ModuleDocMap -> Maybe (Doc String)
lookupNameDoc n = lookupDoc (moduleNameString $ moduleName $ nameModule n) (getOccString n)
stringize :: (Module, Map Name (Doc Name)) -> (String, ModuleDocMap)
stringize = moduleNameString . moduleName *** strDoc where
strDoc = M.mapKeys getOccString . M.map (fmap getOccString)
liftError :: ExceptT String IO a -> ExceptT String IO a
liftError = ExceptT . handle onErr . runExceptT where
onErr :: SomeException -> IO (Either String a)
onErr = return . Left . show