diff options
| -rw-r--r-- | src/Haddock/Interface.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 12 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 7 |
3 files changed, 23 insertions, 4 deletions
diff --git a/src/Haddock/Interface.hs b/src/Haddock/Interface.hs index 0c171cbc..81919aed 100644 --- a/src/Haddock/Interface.hs +++ b/src/Haddock/Interface.hs @@ -46,6 +46,7 @@ import qualified Data.Map as Map import Distribution.Verbosity import System.Directory import System.FilePath +import Text.Printf import Digraph import Exception @@ -161,6 +162,13 @@ processModule verbosity modsum flags modMap instIfaceMap = do out verbosity verbose "Creating interface..." (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap liftIO $ mapM_ putStrLn msg + let (haddockable, haddocked) = ifaceHaddockCoverage interface + percentage = round (fromIntegral haddocked * 100 / fromIntegral haddockable :: Double) :: Int + coveragemsg = printf "haddock coverage for %s: %7s %3d%%" + (ifaceOrigFilename interface) + (printf "%d/%d" haddocked haddockable :: String) + percentage + out verbosity normal coveragemsg interface' <- liftIO $ evaluate interface return (Just interface') else diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index b6215a34..db2ec05c 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -79,11 +79,18 @@ createInterface tm flags modMap instIfaceMap = do let visibleNames = mkVisibleNames exportItems opts + -- measure haddock documentation coverage. + let + prunedExportItems0 = pruneExportItems exportItems + haddockable = 1 + length exportItems -- module + exports + haddocked = (if isJust mbDoc then 1 else 0) + length prunedExportItems0 + coverage = (haddockable, haddocked) + -- prune the export list to just those declarations that have -- documentation, if the 'prune' option is on. let prunedExportItems - | OptPrune `elem` opts = pruneExportItems exportItems + | OptPrune `elem` opts = prunedExportItems0 | otherwise = exportItems return Interface { @@ -101,7 +108,8 @@ createInterface tm flags modMap instIfaceMap = do ifaceDeclMap = declMap, ifaceSubMap = mkSubMap declMap exportedNames, ifaceInstances = instances, - ifaceInstanceDocMap = instanceDocMap + ifaceInstanceDocMap = instanceDocMap, + ifaceHaddockCoverage = coverage } diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 33892e49..b0ac6cac 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -99,9 +99,12 @@ data Interface = Interface { ifaceInstances :: ![Instance], -- | Documentation of instances defined in the module. - ifaceInstanceDocMap :: Map Name (Doc Name) -} + ifaceInstanceDocMap :: Map Name (Doc Name), + -- | The number of haddockable and haddocked items in the module, as a + -- tuple. Haddockable items are the exports and the module itself. + ifaceHaddockCoverage :: (Int,Int) +} -- | A smaller version of 'Interface' that can be created from Haddock's -- interface files ('InterfaceFile'). |