aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Michael <simon@joyful.com>2010-09-22 17:58:06 +0000
committerSimon Michael <simon@joyful.com>2010-09-22 17:58:06 +0000
commit0f8e38017cbb981ea07e52d5a4a7f4736c30718b (patch)
treeb753d4d8317cf3f13323a8db6dbf2493fd460168
parenta419044739b732030c6ba8ad7767a802e449026a (diff)
print haddock coverage info on stdout when generating docs
A module's haddockable items are its exports and the module itself. The output is lightly formatted so you can align the :'s and sort for readability.
-rw-r--r--src/Haddock/Interface.hs8
-rw-r--r--src/Haddock/Interface/Create.hs12
-rw-r--r--src/Haddock/Types.hs7
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').