hdocs 0.4.1.3 → 0.4.2.0

raw patch · 4 files changed

+39/−36 lines, 4 filesdep +haddock-librarydep ~haddock-apiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: haddock-library

Dependency ranges changed: haddock-api

API changes (from Hackage documentation)

Files

• hdocs.cabal +3/−2
• src/HDocs/Haddock.hs +14/−13
• src/HDocs/Module.hs +18/−17
• tools/hdocs.hs +4/−4

@@ -1,5 +1,5 @@ name:                hdocs
-version:             0.4.1.3
+version:             0.4.2.0
 synopsis:            Haskell docs tool
 description:
   Tool and library to get docs for installed packages and source files.
@@ -38,7 +38,8 @@     filepath >= 1.3.0,
     ghc >= 7.8.1,
     ghc-paths >= 0.1.0,
-    haddock-api >= 2.15.0 && < 2.16.0,
+    haddock-library == 1.2.*,
+    haddock-api >= 2.16.0 && < 2.17.0,
     containers >= 0.5.0,
     transformers >= 0.3.0,
     MonadCatchIO-transformers >= 0.3.0,

@@ -19,12 +19,13 @@ import Control.Applicative
 import Control.Arrow
 import Control.Exception
-import Control.Monad.Error
+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
@@ -34,17 +35,17 @@ import HDocs.Base
 
 -- | Read all installed docs
-readInstalledDocs :: [String] -> ErrorT String IO (Map String ModuleDocMap)
+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)
 
 -- | Read docs from .haddock file
-readHaddock :: FilePath -> ErrorT String IO (Map String ModuleDocMap)
+readHaddock :: FilePath -> ExceptT String IO (Map String ModuleDocMap)
 readHaddock f = M.fromList . map installedInterfaceDocs <$> readInstalledInterfaces f
 
 -- | Read docs for haskell module
-readSource :: [String] -> FilePath -> ErrorT String IO (String, ModuleDocMap)
+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
@@ -52,7 +53,7 @@ 
 -- | Get docs for 'InstalledInterface'
 installedInterfaceDocs :: InstalledInterface -> (String, ModuleDocMap)
-installedInterfaceDocs = stringize . (instMod &&& instDocMap)
+installedInterfaceDocs = stringize . (instMod &&& (fmap _doc . instDocMap))
 
 -- | Get docs for 'InstalledInterface's
 installedInterfacesDocs :: [InstalledInterface] -> Map String ModuleDocMap
@@ -60,23 +61,23 @@ 
 -- | Get docs for 'Interface'
 interfaceDocs :: Interface -> (String, ModuleDocMap)
-interfaceDocs = stringize . (ifaceMod &&& ifaceDocMap)
+interfaceDocs = stringize . (ifaceMod &&& (fmap _doc . ifaceDocMap))
 
 -- | Get list of haddock files in package db
-haddockFiles :: [String] -> ErrorT String IO [FilePath]
-haddockFiles opts = ErrorT $ withInitializedPackages opts $ return . maybe
+haddockFiles :: [String] -> ExceptT String IO [FilePath]
+haddockFiles opts = ExceptT $ withInitializedPackages opts $ return . maybe
 	(Left "Package database empty")
 	(Right . concatMap haddockInterfaces) .
 	pkgDatabase
 
 -- | Read installed interface
-readInstalledInterfaces :: FilePath -> ErrorT String IO [InstalledInterface]
+readInstalledInterfaces :: FilePath -> ExceptT String IO [InstalledInterface]
 readInstalledInterfaces f = do
-	ifile <- liftError $ ErrorT $ readInterfaceFile freshNameCache f
+	ifile <- liftError $ ExceptT $ readInterfaceFile freshNameCache f
 	return $ ifInstalledIfaces ifile
 
 -- | Read installed interfaces for package
-readPackageInterfaces :: PackageConfig -> ErrorT String IO [InstalledInterface]
+readPackageInterfaces :: PackageConfig -> ExceptT String IO [InstalledInterface]
 readPackageInterfaces = liftM concat . mapM readInstalledInterfaces . haddockInterfaces
 
 -- | Lookup doc
@@ -91,7 +92,7 @@ stringize = moduleNameString . moduleName *** strDoc where
 	strDoc = M.mapKeys getOccString . M.map (fmap getOccString)
 
-liftError :: ErrorT String IO a -> ErrorT String IO a
-liftError = ErrorT . handle onErr . runErrorT where
+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

@@ -9,7 +9,7 @@ 	) where
 
 import Control.Applicative
-import Control.Monad.Error
+import Control.Monad.Except
 
 import Data.List
 import Data.Map (Map)
@@ -20,6 +20,7 @@ 
 import DynFlags
 import Module
+import Outputable (showSDoc, ppr)
 import Packages
 import Name
 
@@ -27,46 +28,46 @@ import qualified HDocs.Haddock as H
 
 -- | Load docs for all exported module symbols
-moduleDocs :: [String] -> String -> ErrorT String IO ModuleDocMap
-moduleDocs opts mname = ErrorT $ withInitializedPackages opts (runErrorT . moduleDocs') where
-	moduleDocs' :: DynFlags -> ErrorT String IO ModuleDocMap
+moduleDocs :: [String] -> String -> ExceptT String IO ModuleDocMap
+moduleDocs opts mname = ExceptT $ withInitializedPackages opts (runExceptT . moduleDocs') where
+	moduleDocs' :: DynFlags -> ExceptT String IO ModuleDocMap
 	moduleDocs' d = do
 		pkg <- case pkgs of
 			[] -> throwError $ "Module " ++ mname ++ " not found"
 			[pkg] -> return pkg
-			_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map pkgId pkgs)
+			_ -> throwError $ "Module " ++ mname ++ " found in several packages: " ++ intercalate ", " (map (pkgId d) pkgs)
 		ifaces <- H.readPackageInterfaces pkg
 		iface <- maybe
-			(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId pkg)
+			(throwError $ "Module " ++ mname ++ " not found in package " ++ pkgId d pkg)
 			return
 			(find ((== mname) . moduleNameString . moduleName . instMod) ifaces)
 
 		depsfaces <- liftM concat $ mapM H.readPackageInterfaces $
-			map (getPackageDetails (pkgState d)) $ ifacePackageDeps iface
+			map (getPackageDetails d) $ ifacePackageDeps iface
 
 		let
 			deps = filter (ifaceDep iface) $ ifaces ++ depsfaces
 
 		return $ snd $ exportsDocs (H.installedInterfacesDocs deps) iface
 		where
-			pkgs = filter exposed $ map fst $ lookupModuleInAllPackages d (mkModuleName mname)
+			pkgs = filter exposed $ map snd $ lookupModuleInAllPackages d (mkModuleName mname)
 
-	namePackage :: Name -> PackageId
-	namePackage = modulePackageId . nameModule
+	namePackage :: Name -> PackageKey
+	namePackage = modulePackageKey . nameModule
 
-	ifacePackageDeps :: InstalledInterface -> [PackageId]
-	ifacePackageDeps i = (modulePackageId $ instMod i) `delete` (nub . map namePackage . instExports $ i)
+	ifacePackageDeps :: InstalledInterface -> [PackageKey]
+	ifacePackageDeps i = (modulePackageKey $ instMod i) `delete` (nub . map namePackage . instExports $ i)
 
 	ifaceDep :: InstalledInterface -> InstalledInterface -> Bool
 	ifaceDep i idep = instMod i /= instMod idep && instMod idep `elem` map nameModule (instExports i)
 
-	pkgId :: PackageConfig -> String
-	pkgId = display . installedPackageId
+	pkgId :: DynFlags -> PackageConfig -> String
+	pkgId d = showSDoc d . ppr . installedPackageId
 
 -- | Load docs for all installed modules
-installedDocs :: [String] -> ErrorT String IO (Map String ModuleDocMap)
-installedDocs opts = ErrorT $ withInitializedPackages opts (runErrorT . installedDocs') where
-	installedDocs' :: DynFlags -> ErrorT String IO (Map String ModuleDocMap)
+installedDocs :: [String] -> ExceptT String IO (Map String ModuleDocMap)
+installedDocs opts = ExceptT $ withInitializedPackages opts (runExceptT . installedDocs') where
+	installedDocs' :: DynFlags -> ExceptT String IO (Map String ModuleDocMap)
 	installedDocs' d = do
 		fs <- maybe (throwError "Package database empty") (return . concatMap haddockInterfaces) $ pkgDatabase d
 		ifaces <- liftM concat $ mapM ((`mplus` return []) . H.readInstalledInterfaces) fs

@@ -2,7 +2,7 @@ 	main
 	) where
 
-import Control.Monad.Error
+import Control.Monad.Except
 import Data.Aeson
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.ByteString.Lazy (toStrict)
@@ -52,10 +52,10 @@ 		jsonError err = object [
 			T.pack "error" .= err]
 
-		run :: ToJSON a => ErrorT String IO a -> IO ()
-		run act = runErrorT act >>= putStrLn . either (toStr . jsonError) toStr
+		run :: ToJSON a => ExceptT String IO a -> IO ()
+		run act = runExceptT act >>= putStrLn . either (toStr . jsonError) toStr
 
-		loadDocs :: String -> ErrorT String IO ModuleDocMap
+		loadDocs :: String -> ExceptT String IO ModuleDocMap
 		loadDocs m
 			| takeExtension m == ".hs" = liftM snd $ readSource (optionGHC cfg) m
 			| otherwise = moduleDocs (optionGHC cfg) m